Form.st
author Claus Gittinger <cg@exept.de>
Wed, 17 Jul 1996 14:19:00 +0200
changeset 951 ebedf8da0e89
parent 935 e71b1be3eb6c
child 1058 103860173cb2
permissions -rw-r--r--
initGC stuff fixed
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
     3
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     4
48194c26a46c Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
48194c26a46c Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
48194c26a46c Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
48194c26a46c Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
48194c26a46c Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
48194c26a46c Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
48194c26a46c Initial revision
claus
parents:
diff changeset
    11
"
48194c26a46c Initial revision
claus
parents:
diff changeset
    12
721
ba7861418087 renamed DisplayMedium to Graphicsmedium & changed inheritance
Claus Gittinger <cg@exept.de>
parents: 680
diff changeset
    13
GraphicsMedium subclass:#Form
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
    14
	instanceVariableNames:'depth localColorMap offset data fileName'
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
    15
	classVariableNames:'VeryLightGreyForm LightGreyForm GreyForm DarkGreyForm
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
    16
		VeryDarkGreyForm AdditionalBitmapDirectoryNames
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
    17
		BlackAndWhiteColorMap DitherPatternArray'
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
    18
	poolDictionaries:''
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
    19
	category:'Graphics-Display Objects'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    20
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    21
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
    22
!Form  class methodsFor:'documentation'!
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    23
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    24
copyright
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    25
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    26
 COPYRIGHT (c) 1989 by Claus Gittinger
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
    27
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    28
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    29
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    30
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    32
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    33
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    34
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    35
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    36
!
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    37
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    38
documentation
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    39
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    40
    Instances of this class represent forms (i.e. bit- and pixmaps)
590
fc18ba574a4d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    41
    which can be created on a drawing device. 
fc18ba574a4d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    42
    In X, these device resources are XPixmaps.
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    43
    Not all devices will support forms.
134
claus
parents: 133
diff changeset
    44
claus
parents: 133
diff changeset
    45
    NOTICE:
589
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    46
        the Form class is a historic leftover and now only used for real
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    47
        device forms (i.e. on devices which support downloading bitmaps).
590
fc18ba574a4d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    48
589
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    49
        In your application, you should always use Image, both for compatibility
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    50
        with ST-80 and for device independence, since Form may not be supported
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
    51
        by all devices.
589
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    52
935
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    53
    WARNING:
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    54
        Forms created on some device may not be recreatable, when an
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    55
        image is restarted on a display with different display capabilities.
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    56
        For example, a 24bit truecolor form will be lost when the image is
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    57
        saved and restarted in an 8bit or monochrome display.
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    58
        Worse: the information is completely lost.
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    59
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    60
        With images, the original information is always preserved, although
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    61
        the display may be with less resolution, dithered or otherwise
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    62
        approximated.
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    63
591
d071af7739db commentary
Claus Gittinger <cg@exept.de>
parents: 590
diff changeset
    64
    [See also:]
589
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    65
        Image DeviceDrawable
610
f6951a01350f documentation
Claus Gittinger <cg@exept.de>
parents: 594
diff changeset
    66
f6951a01350f documentation
Claus Gittinger <cg@exept.de>
parents: 594
diff changeset
    67
    [author:]
f6951a01350f documentation
Claus Gittinger <cg@exept.de>
parents: 594
diff changeset
    68
        Claus Gittinger
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    69
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    70
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    71
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
    72
!Form  class methodsFor:'initialization'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    73
889
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    74
flushDeviceForms
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    75
    "recreate all forms on aDevice; called by Workstation, to
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    76
     have all background bitmaps at hand, when views are restored"
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    77
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    78
    Lobby do:[:aDrawable |
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    79
        aDrawable isForm ifTrue:[
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
    80
            (aDrawable graphicsDevice notNil) ifTrue:[
889
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    81
                "now, try to recreate it"
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    82
                aDrawable recreate.
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    83
            ]
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    84
        ]
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    85
    ]
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    86
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    87
    "Created: 18.6.1996 / 13:04:59 / cg"
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
    88
    "Modified: 5.7.1996 / 17:56:02 / cg"
889
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    89
!
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    90
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    91
initialize
126
4fc31fd808c8 *** empty log message ***
claus
parents: 118
diff changeset
    92
    "initialize set of dictionaries to look for bitmaps"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    93
48194c26a46c Initial revision
claus
parents:
diff changeset
    94
    AdditionalBitmapDirectoryNames isNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
    95
	AdditionalBitmapDirectoryNames := #('/usr/lib/X11/bitmaps').
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    96
    
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
    97
	"want to be informed when returning from snapshot"
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
    98
	ObjectMemory addDependent:self.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    99
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   100
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   101
48194c26a46c Initial revision
claus
parents:
diff changeset
   102
reinitializeAllOn:aDevice
48194c26a46c Initial revision
claus
parents:
diff changeset
   103
    "recreate all forms on aDevice; called by Workstation, to
48194c26a46c Initial revision
claus
parents:
diff changeset
   104
     have all background bitmaps at hand, when views are restored"
48194c26a46c Initial revision
claus
parents:
diff changeset
   105
127
98b0725782bd *** empty log message ***
claus
parents: 126
diff changeset
   106
    Lobby do:[:aDrawable |
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   107
        (aDrawable graphicsDevice == aDevice) ifTrue:[
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   108
            aDrawable isForm ifTrue:[
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   109
                "now, try to recreate it"
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   110
                aDrawable recreate.
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   111
            ]
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   112
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   113
    ]
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   114
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   115
    "Modified: 5.7.1996 / 17:55:58 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   116
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   117
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   118
update:something with:aParameter from:changedObject
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   119
    "sent just before snapOut and just after a snapIn"
48194c26a46c Initial revision
claus
parents:
diff changeset
   120
48194c26a46c Initial revision
claus
parents:
diff changeset
   121
    (something == #save) ifTrue:[
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   122
        "get all bits from the device into saveable arrays"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   123
        Lobby do:[:aDrawable |
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   124
            aDrawable isForm ifTrue:[
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   125
                aDrawable getBits
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   126
            ]
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   127
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   128
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   129
    (something == #restarted) ifTrue:[
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   130
        "remove all left-over device info"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   131
        Lobby do:[:aDrawable |
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   132
            aDrawable isForm ifTrue:[
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   133
                aDrawable flushDeviceHandles.
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   134
                Lobby registerChange:aDrawable 
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   135
            ]
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   136
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   137
    ]
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   138
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   139
    "Modified: 15.6.1996 / 15:44:09 / cg"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   140
    "Created: 15.6.1996 / 15:47:50 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   141
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   142
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   143
!Form  class methodsFor:'instance creation'!
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   144
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   145
extent:ext
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   146
    "create a new, cleared form, take dimensions from ext.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   147
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   148
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   149
    |newForm|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   150
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   151
    newForm := self width:(ext x) height:(ext y).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   152
    newForm fill:(Color colorId:0).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   153
    newForm paint:(Color colorId:1).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   154
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   155
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   156
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   157
extent:ext fromArray:data
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   158
    "create a new form, take dimensions from ext, bits from data.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   159
     Smalltalk-80 compatibility."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   160
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   161
    ^ self width:(ext x) height:(ext y) offset:0@0 fromArray:data
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   162
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   163
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   164
extent:ext fromArray:data offset:offs
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   165
    "create a new form, take dimensions from ext, bits from data.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   166
     Smalltalk-80 compatibility."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   167
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   168
    ^ self width:(ext x) height:(ext y) offset:offs fromArray:data
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   169
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   170
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   171
extent:ext offset:anOffset
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   172
    "create a new, cleared form, take dimensions from ext.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   173
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   174
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   175
    ^ (self extent:ext) offset:anOffset.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   176
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   177
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   178
width:w height:h
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   179
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   180
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   181
    ^ self width:w height:h on:Screen current
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   182
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   183
    "Modified: 4.6.1996 / 22:16:33 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   184
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   185
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   186
width:w height:h depth:d
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   187
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   188
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   189
    ^ self width:w height:h depth:d on:Screen current
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   190
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   191
    "Modified: 4.6.1996 / 22:16:51 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   192
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   193
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   194
width:w height:h depth:d on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   195
    "create a new form with depth d on device, aDevice"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   196
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   197
    ^ (self on:aDevice) width:w height:h depth:d
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   198
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   199
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   200
width:w height:h fromArray:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   201
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   202
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   203
    ^ self width:w height:h fromArray:anArray on:Screen current
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   204
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   205
    "Modified: 4.6.1996 / 22:17:05 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   206
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   207
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   208
width:w height:h fromArray:anArray on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   209
    "create a new form on device, aDevice and
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   210
     initialize the pixels from anArray"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   211
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   212
    ^ (self on:aDevice) width:w height:h fromArray:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   213
!
109
ba47d9d6bda8 *** empty log message ***
claus
parents: 107
diff changeset
   214
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   215
width:w height:h offset:offs fromArray:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   216
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   217
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   218
    ^ (self on:Screen current) width:w height:h offset:offs fromArray:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   219
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   220
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   221
width:w height:h on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   222
    "create a new form on device, aDevice; depth is what device likes most"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   223
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   224
    ^ (self on:aDevice) width:w height:h
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   225
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   226
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   227
!Form  class methodsFor:'ST-80 compatibility'!
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   228
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   229
and
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   230
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   231
     In ST-80rel2.x, these used to be numeric constants; in ST/X,
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   232
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   233
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   234
    ^ #and
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   235
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   236
    "Modified: 2.5.1996 / 11:41:23 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   237
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   238
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   239
black
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   240
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   241
     In old st80, you could use `Form black' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   242
     - here we return the black color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   243
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   244
    ^ Color black
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   245
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   246
    "Modified: 2.5.1996 / 11:44:17 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   247
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   248
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   249
darkGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   250
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   251
     In old st80, you could use `Form darkGray' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   252
     - here we return the darkGray color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   253
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   254
    ^ Color darkGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   255
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   256
    "Modified: 2.5.1996 / 11:44:06 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   257
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   258
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   259
darkGrey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   260
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   261
     In old st80, you could use `Form darkGrey' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   262
     - here we return the darkGrey color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   263
746
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   264
    ^ Color darkGray
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   265
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   266
    "Modified: 28.5.1996 / 20:47:54 / cg"
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   267
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   268
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   269
gray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   270
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   271
     In old st80, you could use `Form gray' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   272
     - here we return the grey color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   273
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   274
    ^ Color gray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   275
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   276
    "Modified: 2.5.1996 / 11:43:44 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   277
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   278
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   279
grey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   280
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   281
     In old st80, you could use `Form grey' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   282
     - here we return the grey color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   283
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   284
    ^ Color grey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   285
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   286
    "Modified: 2.5.1996 / 11:43:17 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   287
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   288
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   289
lightGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   290
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   291
     In old st80, you could use `Form lightGray' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   292
     - here we return the lightGray color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   293
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   294
    ^ Color lightGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   295
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   296
    "Created: 2.5.1996 / 11:40:07 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   297
    "Modified: 2.5.1996 / 11:43:21 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   298
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   299
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   300
lightGrey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   301
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   302
     In old st80, you could use `Form lightGray' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   303
     - here we return the lightGray color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   304
746
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   305
    ^ Color lightGray
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   306
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   307
    "Modified: 28.5.1996 / 20:53:28 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   308
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   309
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   310
over
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   311
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   312
     In ST-80rel2.x, these used to be numeric constants; in ST/X,
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   313
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   314
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   315
    ^ #copy
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   316
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   317
    "Modified: 2.5.1996 / 11:41:31 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   318
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   319
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   320
paint
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   321
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   322
     In ST-80rel2.x, these used to be numeric constants; in ST/X,
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   323
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   324
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   325
    ^ #copy
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   326
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   327
    "Modified: 2.5.1996 / 11:41:40 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   328
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   329
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   330
reverse
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   331
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   332
     In ST-80rel2.x, these used to be numeric constants; in ST/X,
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   333
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   334
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   335
    ^ #xor
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   336
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   337
    "Modified: 2.5.1996 / 11:41:45 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   338
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   339
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   340
under
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   341
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   342
     In ST-80rel2.x, these used to be numeric constants; in ST/X,
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   343
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   344
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   345
    ^ #or
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   346
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   347
    "Modified: 2.5.1996 / 11:41:49 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   348
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   349
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   350
white
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   351
    "ST80rel2.x compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   352
     In old st80, you could use `Form white' for drawing 
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   353
     - here we return the white color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   354
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   355
    ^ Color white
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   356
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   357
    "Modified: 2.5.1996 / 11:42:50 / cg"
109
ba47d9d6bda8 *** empty log message ***
claus
parents: 107
diff changeset
   358
! !
ba47d9d6bda8 *** empty log message ***
claus
parents: 107
diff changeset
   359
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   360
!Form  class methodsFor:'cleanup'!
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   361
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   362
lowSpaceCleanup
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   363
    "cleanup in low-memory situations"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   364
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   365
    DitherPatternArray := nil
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   366
! !
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   367
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   368
!Form  class methodsFor:'file search'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   369
48194c26a46c Initial revision
claus
parents:
diff changeset
   370
findBitmapFile:fileName
48194c26a46c Initial revision
claus
parents:
diff changeset
   371
    "find the bitmap file in one of the standard places;
48194c26a46c Initial revision
claus
parents:
diff changeset
   372
     return the pathName or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   373
48194c26a46c Initial revision
claus
parents:
diff changeset
   374
    |aStream path|
48194c26a46c Initial revision
claus
parents:
diff changeset
   375
48194c26a46c Initial revision
claus
parents:
diff changeset
   376
    ((fileName at:1) == $/) ifTrue:[^ fileName].
48194c26a46c Initial revision
claus
parents:
diff changeset
   377
    (fileName startsWith:'../') ifTrue:[^ fileName].
48194c26a46c Initial revision
claus
parents:
diff changeset
   378
    (fileName startsWith:'./') ifTrue:[^ fileName].
127
98b0725782bd *** empty log message ***
claus
parents: 126
diff changeset
   379
    fileName asFilename exists ifTrue:[^ fileName].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   380
134
claus
parents: 133
diff changeset
   381
    aStream := Smalltalk bitmapFileStreamFor:fileName.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   382
    aStream notNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   383
	path := aStream pathName.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   384
	aStream close.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   385
	^ path
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   386
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   387
    AdditionalBitmapDirectoryNames notNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   388
	AdditionalBitmapDirectoryNames do:[:aPath |
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   389
	    path := aPath , '/' , fileName.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   390
	    (OperatingSystem isReadable:path) ifTrue:[
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   391
		^ path
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   392
	    ]
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   393
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   394
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   395
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   396
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   397
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   398
!Form  class methodsFor:'fileIn/Out'!
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   399
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   400
fromFile:filename
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   401
    "create a new form taking the bits from a file on the default device.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   402
     WARNING:
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   403
     Please do no longer use this, since it will not work
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   404
     correctly in multi-display applications (creates the form on the
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   405
     default Display).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   406
     Use #fromFile:on: and pass the devive as argument."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   407
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   408
    ^ self fromFile:filename on:Screen current
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   409
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   410
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   411
fromFile:filename on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   412
    "create a new form on device, aDevice and
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   413
     initialize the pixels from the file filename"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   414
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   415
    ^ (self on:aDevice) readFromFile:filename
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   416
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   417
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   418
fromFile:filename resolution:dpi
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   419
    "create a new form taking the bits from a file on the default device
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   420
     the data in the file is assumed to be for dpi resolution;
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   421
     if it is different from the displays resolution, magnify or
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   422
     shrink the picture (but only in integer magnification steps).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   423
     WARNING:
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   424
     Please do no longer use this, since it will not work
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   425
     correctly in multi-display applications (creates the form on the
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   426
     default Display).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   427
     Use #fromFile:resolution:on: and pass the devive as argument."
98
cd6af625d477 *** empty log message ***
claus
parents: 89
diff changeset
   428
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   429
    ^ self fromFile:filename resolution:dpi on:Screen current
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   430
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   431
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   432
fromFile:filename resolution:dpi on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   433
    "create a new form on device, aDevice and
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   434
     initialize the pixels from the file filename;
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   435
     the data in the file is assumed to be for dpi resolution;
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   436
     if it is different from the displays resolution, magnify or
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   437
     shrink the picture (but only in integer magnification steps)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   438
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   439
    ^ (self on:aDevice) readFromFile:filename resolution:dpi
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   440
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   441
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   442
readFrom:fileName
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   443
    "same as Form>>fromFile: - for ST-80 compatibility.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   444
     WARNING:
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   445
     Please do no longer use this, since it will not work
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   446
     correctly in multi-display applications (creates the form on the
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   447
     default Display).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   448
     Use #fromFile:on: and pass the devive as argument."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   449
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   450
    ^ self fromFile:fileName on:Screen current
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   451
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   452
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   453
!Form  class methodsFor:'obsolete instance creation'!
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   454
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   455
darkGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   456
    "return a darkGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   457
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   458
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   459
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   460
    ((aDevice == Display) and:[DarkGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   461
	^ DarkGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   462
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   463
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   464
    f := self width:8 height:4 fromArray:(self darkGreyFormBits) on:aDevice.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   465
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   466
	DarkGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   467
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   468
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   469
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   470
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   471
grey:percent on:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   472
    "return a form for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   473
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   474
    (percent < 20) ifTrue:[^ Color black on:aDevice].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   475
    (percent < 40) ifTrue:[^ self darkGreyFormOn:aDevice].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   476
    (percent < 60) ifTrue:[^ self mediumGreyFormOn:aDevice].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   477
    (percent < 80) ifTrue:[^ self lightGreyFormOn:aDevice].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   478
    ^ Color white on:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   479
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   480
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   481
lightGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   482
    "return a lightGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   483
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   484
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   485
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   486
    ((aDevice == Display) and:[LightGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   487
	^ LightGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   488
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   489
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   490
    f := self width:8 height:4 fromArray:(self lightGreyFormBits) on:aDevice.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   491
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   492
	LightGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   493
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   494
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   495
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   496
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   497
mediumGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   498
    "return a grey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   499
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   500
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   501
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   502
    ((aDevice == Display) and:[GreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   503
	^ GreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   504
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   505
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   506
    f := self width:8 height:4 fromArray:(self greyFormBits) on:aDevice.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   507
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   508
	GreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   509
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   510
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   511
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   512
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   513
veryDarkGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   514
    "return a veryDarkGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   515
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   516
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   517
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   518
    ((aDevice == Display) and:[VeryDarkGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   519
	^ VeryDarkGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   520
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   521
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   522
    f := self width:8 height:4 fromArray:(self veryDarkGreyFormBits) on:aDevice.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   523
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   524
	VeryDarkGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   525
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   526
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   527
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   528
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   529
veryLightGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   530
    "return a veryLightGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   531
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   532
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   533
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   534
    ((aDevice == Display) and:[VeryLightGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   535
	^ VeryLightGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   536
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   537
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   538
    f := self width:8 height:4 fromArray:(self veryLightGreyFormBits) on:aDevice.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   539
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   540
	VeryLightGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   541
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   542
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   543
! !
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   544
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
   545
!Form  class methodsFor:'obsolete patterns'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   546
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   547
darkGreyFormBits
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   548
    "return a pattern usable to simulate darkGray on monochrome device"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   549
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   550
    ^ #(2r10111011
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   551
	2r11101110
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   552
	2r10111011
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   553
	2r11101110)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   554
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   555
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   556
grey12Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   557
    "return a pattern with 12% grey, usable for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   558
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   559
    ^ #(2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   560
	2r00000000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   561
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   562
	2r00000000)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   563
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   564
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   565
grey25Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   566
    "return a pattern with 25% grey, usable for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   567
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   568
    ^ #(2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   569
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   570
	2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   571
	2r01000100)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   572
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   573
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   574
grey37Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   575
    "return a pattern with 37% grey, usable for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   576
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   577
    ^ #(2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   578
	2r10101010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   579
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   580
	2r10101010)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   581
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   582
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   583
grey50Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   584
    "return a pattern with 50% grey, usable for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   585
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   586
    ^ #(2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   587
	2r10101010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   588
	2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   589
	2r10101010)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   590
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   591
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   592
grey6Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   593
    "return a pattern with 6% grey, usable for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   594
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   595
    ^ #(2r00000001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   596
	2r00000000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   597
	2r00010000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   598
	2r00000000)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   599
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   600
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   601
greyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   602
    "return a pattern usable to simulate gray on monochrome device"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   603
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   604
    ^ #(2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   605
	2r10101010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   606
	2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   607
	2r10101010)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   608
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   609
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   610
lightGreyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   611
    "return a pattern usable to simulate lightGray on monochrome device"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   612
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   613
    ^ #(2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   614
	2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   615
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   616
	2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   617
	2r01000100)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   618
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   619
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   620
veryDarkGreyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   621
    "return a pattern usable to simulate veryDarkGray on monochrome device"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   622
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   623
    ^ #(2r01110111
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   624
	2r11111111
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   625
	2r11011101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   626
	2r11111111)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   627
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   628
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   629
veryLightGreyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   630
    "return a pattern usable to simulate veryDarkGray on monochrome device"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   631
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   632
    ^ #(2r10001000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   633
	2r00000000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   634
	2r00100010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   635
	2r00000000)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   636
! !
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   637
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   638
!Form methodsFor:'ST-80 compatibility'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   639
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   640
displayOn:aGC at:aPoint
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   641
    "draw in aGC.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   642
     Smalltalk-80 (2.x) compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   643
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   644
    ^ self displayOn:aGC x:aPoint x y:aPoint y rule:#copy
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   645
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   646
    "Modified: 12.5.1996 / 20:16:15 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   647
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   648
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   649
displayOn:aGC at:aPoint rule:rule
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   650
    "draw in aGC.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   651
     Smalltalk-80 (2.x) compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   652
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   653
    self displayOn:aGC x:aPoint x y:aPoint y rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   654
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   655
    "Modified: 12.5.1996 / 20:16:02 / cg"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   656
!
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   657
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   658
displayOn:aGC rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   659
    "draw in aGC.
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   660
     Smalltalk-80 (2.x) compatibility"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   661
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   662
    ^ self displayOn:aGC x:0 y:0 rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   663
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   664
    "Modified: 12.5.1996 / 20:15:41 / cg"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   665
!
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   666
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   667
displayOn:aGC x:x y:y
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   668
    "draw in aGC.
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   669
     Smalltalk-80 (2.x) compatibility"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   670
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   671
    ^ self displayOn:aGC x:x y:y rule:#copy
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   673
    "Created: 12.5.1996 / 20:15:05 / cg"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   674
!
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   675
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   676
displayOn:aGC x:x y:y rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   677
    "draw in aGC.
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   678
     Smalltalk-80 (2.x) compatibility"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   679
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   680
    |f|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   681
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   682
    f := aGC function.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   683
    aGC function:rule.
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   684
    aGC displayOpaqueForm:self x:x y:y.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   685
    aGC function:f.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   686
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   687
    "Created: 12.5.1996 / 20:15:26 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   688
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   689
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   690
offset
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   691
    "set the offset.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   692
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   693
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   694
    ^ offset
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   695
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   696
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   697
offset:org
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   698
    "set the offset.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   699
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   700
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   701
    offset := org
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   702
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   703
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   704
!Form methodsFor:'accessing'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   705
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   706
bits
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   707
    "return a ByteArray filled with my bits -
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   708
     for depth 8 forms, 1 pixel/byte is filled;
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   709
     for depth 1 forms, 8 pixels/byte are filled
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   710
     for depth 4 forms, 2 pixels/byte are filled.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   711
     Padding is done to the next byte-boundary 
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   712
     (i.e. for width==13 and depth==1 it will return 2 bytes per scanline)"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   713
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   714
    |bytesPerLine   "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   715
     bytesPerLineIn "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   716
     inData tmpData info
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   717
     srcIndex "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   718
     dstIndex "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   719
     buffer|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   720
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   721
    data notNil ifTrue:[
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   722
        ^ data
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   723
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   724
    drawableId isNil ifTrue:[
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   725
        fileName notNil ifTrue:[
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   726
            ^ (self on:Screen current) bits
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   727
        ].
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   728
        ^ nil
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   729
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   730
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   731
    bytesPerLine := (width * depth + 31) // 32 * 4.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   732
    inData := ByteArray uninitializedNew:(bytesPerLine * height).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   733
    info := device getBitsFrom:drawableId x:0 y:0 width:width height:height into:inData. 
398
2b35bb58a82b changes for new returned info from getBits
Claus Gittinger <cg@exept.de>
parents: 278
diff changeset
   734
    bytesPerLineIn := (info at:#bytesPerLine).                    "what I got"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   735
    bytesPerLine := (width * depth + 7) // 8.                     "what I want"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   736
    (bytesPerLine ~~ bytesPerLineIn) ifTrue:[
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   737
        "
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   738
         different padding - have to copy over row-wise
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   739
        "
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   740
        tmpData := inData.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   741
        inData := ByteArray uninitializedNew:(bytesPerLine * height).
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   742
        srcIndex := 1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   743
        dstIndex := 1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   744
        1 to:height do:[:hi |
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   745
            inData replaceFrom:dstIndex to:(dstIndex + bytesPerLine - 1)
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   746
                          with:tmpData startingAt:srcIndex.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   747
            dstIndex := dstIndex + bytesPerLine.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   748
            srcIndex := srcIndex + bytesPerLineIn
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   749
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   750
    ] ifFalse:[
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   751
        "
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   752
         same padding - copy over all in one chunk
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   753
        "
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   754
        (bytesPerLine * height) ~~ inData size ifTrue:[
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   755
            tmpData := inData.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   756
            inData := ByteArray uninitializedNew:(bytesPerLine * height).
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   757
            inData replaceFrom:1 to:bytesPerLine * height with:tmpData startingAt:1
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   758
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   759
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   760
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   761
     have to reverse bytes, if not msbFirst ?
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   762
    "
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   763
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   764
"/    (info at:#byteOrder) ~~ #msbFirst ifTrue:[
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   765
"/        buffer := ByteArray new:bytesPerLine.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   766
"/        dstIndex := 1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   767
"/        1 to:height do:[:hi |
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   768
"/            buffer replaceFrom:1 to:bytesPerLine with:inData startingAt:dstIndex.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   769
"/            buffer reverse.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   770
"/            inData replaceFrom:dstIndex to:dstIndex+bytesPerLine-1 with:buffer startingAt:1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   771
"/            dstIndex := dstIndex + bytesPerLine
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   772
"/        ]
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   773
"/    ].
398
2b35bb58a82b changes for new returned info from getBits
Claus Gittinger <cg@exept.de>
parents: 278
diff changeset
   774
    (info at:#bitOrder) ~~ #msbFirst ifTrue:[
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   775
        buffer := ByteArray new:bytesPerLine.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   776
        dstIndex := 1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   777
        1 to:height do:[:hi |
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   778
            buffer replaceFrom:1 to:bytesPerLine with:inData startingAt:dstIndex.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   779
            buffer expandPixels:8 width:bytesPerLine height:1 into:buffer
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   780
                                mapping:(ImageReader reverseBits).  "/ translate only
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   781
            inData replaceFrom:dstIndex to:dstIndex+bytesPerLine-1 with:buffer startingAt:1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   782
            dstIndex := dstIndex + bytesPerLine
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   783
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   784
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   785
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   786
    ^ inData.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   787
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   788
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   789
bits:aByteArray
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   790
    "set the forms bits; 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   791
     for depth-8 forms, 1 pixel/byte is expected;
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   792
     for depth-1 forms, 8 pixels/byte are expected
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   793
     for depth-4 forms, 2 pixels/byte are expected.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   794
     Padding is expected to the next byte-boundary 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   795
     (i.e. for width==13 and depth==1 2 bytes per scanline are expected)"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   796
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   797
    data := aByteArray
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   798
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   799
    "Modified: 23.4.1996 / 10:06:01 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   800
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   801
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   802
bitsPerSample
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   803
    "for compatibility with Image class ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   804
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   805
    ^ Array with:depth
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   806
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   807
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   808
colorMap
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   809
    "return the receivers colormap"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   810
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   811
    ^ localColorMap
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   812
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   813
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   814
colorMap:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   815
    "set the receivers colormap"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   816
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   817
    localColorMap := anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   818
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   819
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   820
depth
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   821
    "return the receivers depth"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   822
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   823
    ^ depth
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   824
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   825
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   826
filename
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   827
    "return the filename, from which the receiver was created,
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   828
     or nil, if it was not read from a file"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   829
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   830
    ^ fileName
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   831
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   832
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   833
forgetBits
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   834
    "for image, which also keeps the bits - so there is
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   835
     no need to hold them again here"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   836
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   837
    data := nil
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   838
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   839
897
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   840
mask
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   841
    "for compatibility with images; forms have no mask/alpha channel"
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   842
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   843
    ^ nil
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   844
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   845
    "Created: 21.6.1996 / 12:52:42 / cg"
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   846
!
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
   847
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   848
photometric
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   849
    "for compatibility with Image class ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   850
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   851
    depth == 1 ifTrue:[
872
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   852
        localColorMap isNil ifTrue:[
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   853
            ^ #whiteIs0
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   854
        ].
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   855
        ((localColorMap at:1) = Color white) ifTrue:[
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   856
            ((localColorMap at:2) = Color black) ifTrue:[
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   857
                ^ #whiteIs0
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   858
            ].
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   859
        ].
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   860
        ((localColorMap at:1) = Color black) ifTrue:[
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   861
            ((localColorMap at:2) = Color white) ifTrue:[
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   862
                ^ #blackIs0
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   863
            ].
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   864
        ].
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   865
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   866
    ^ #palette
872
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   867
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
   868
    "Modified: 17.6.1996 / 11:45:16 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   869
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   870
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   871
samplesperPixel
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   872
    "for compatibility with Image class ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   873
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   874
    ^ 1
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   875
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   876
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   877
valueAt:aPoint
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   878
    "return the pixel at aPoint; the coordinates start with 0@0
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   879
     in the upper left, increasing to the lower right"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   880
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   881
    ^ self at:aPoint
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   882
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   883
    "Modified: 23.4.1996 / 10:06:55 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   884
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   885
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   886
valueAt:aPoint put:value
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   887
    "set the pixel at aPoint; the coordinates start with 0@0
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   888
     in the upper left, increasing to the lower right."
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   889
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   890
    ^ self at:aPoint put:value
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   891
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   892
    "
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   893
     |f|
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   894
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   895
     f := Form width:10 height:10 depth:1.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   896
     f clear.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   897
     1 to:10 do:[:i |
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   898
        f valueAt:(i @ i) put:1
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   899
     ].
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   900
     f inspect
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   901
    "
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   902
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   903
    "Modified: 23.4.1996 / 10:12:48 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   904
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   905
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   906
!Form methodsFor:'binary storage'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   907
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   908
readBinaryContentsFrom: stream manager: manager
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   909
    "tell the newly restored Form about restoration"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   910
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   911
    super readBinaryContentsFrom: stream manager: manager.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   912
    device := Screen current.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   913
    fileName := nil.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   914
    self restored.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   915
    self recreate.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   916
    Lobby register:self.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   917
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   918
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   919
     |f|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   920
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   921
     f := Form fromFile:'bitmaps/SBrowser.xbm'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   922
     f storeBinaryOn:'foo.bos'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   923
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   924
     (Form readBinaryFrom:'foo.bos') inspect
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   925
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   926
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   927
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   928
storeBinaryDefinitionOn: stream manager: manager
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   929
    "store a binary representation of the receiver on stream.
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   930
     This is an internal interface for binary storage mechanism.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   931
     Redefined to store the actual bits, even if I have been loaded 
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   932
     from a file."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   933
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   934
    data isNil ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   935
        data := self bits.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   936
        super storeBinaryDefinitionOn: stream manager: manager.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   937
        data := nil.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   938
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   939
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   940
    super storeBinaryDefinitionOn: stream manager: manager
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   941
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   942
    "Modified: 23.4.1996 / 09:30:47 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   943
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   944
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   945
!Form methodsFor:'converting'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   946
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   947
asForm
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   948
    "convert & return the receiver into a Form instance - nothing to be done here"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   949
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   950
    ^ self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   951
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   952
    "Modified: 23.4.1996 / 10:14:11 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   953
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   954
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   955
asImage
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   956
    "convert & return the receiver into an Image instance"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   957
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   958
    ^ Image fromForm:self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   959
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   960
    "Modified: 23.4.1996 / 10:13:56 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   961
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   962
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   963
!Form methodsFor:'copying'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   964
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   965
postCopy
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   966
    "redefined to copy the colorMap as well"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   967
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   968
    super postCopy.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   969
    localColorMap := localColorMap copy.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   970
    data := data copy
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   971
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   972
    "Modified: 23.4.1996 / 10:14:46 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   973
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   974
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   975
shallowCopyForFinalization
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   976
    "redefined for faster creation of finalization copies
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   977
     (only device, gcId and drawableId are needed)"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   978
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   979
    |aCopy|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   980
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   981
    aCopy := DeviceFormHandle basicNew.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   982
    aCopy setDevice:device id:drawableId gcId:gcId.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   983
    ^ aCopy
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   984
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   985
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   986
!Form methodsFor:'editing'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   987
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   988
edit
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   989
    "open an imageEditor on the receiver"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   990
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   991
    ImageEditView openOnImage:self
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   992
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   993
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   994
     (Form fromFile:'bitmaps/SBrowser.xbm') edit
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   995
    "
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   996
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
   997
    "Modified: 23.4.1996 / 10:16:02 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   998
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   999
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1000
show
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1001
    "open an imageView on the receiver"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1002
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1003
    ImageView openOnImage:self
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1004
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1005
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1006
     (Form fromFile:'bitmaps/SBrowser.xbm') show
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1007
    "
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1008
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1009
    "Modified: 23.4.1996 / 10:16:12 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1010
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1011
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1012
!Form methodsFor:'getting a device form'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1013
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1014
asFormOn:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1015
    "convert & return the receiver into a Form instance
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1016
     and associate it to a device (i.e. download its bits).
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1017
     Added for protocol compatibility with Image."
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1018
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1019
    aDevice == device ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1020
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1021
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1022
    ^ self on:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1023
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1024
    "Modified: 23.4.1996 / 10:17:26 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1025
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1026
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1027
asMonochromeFormOn:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1028
    "added for protocol compatiblity with Image"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1029
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1030
    aDevice == device ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1031
        depth == 1 ifTrue:[
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1032
            ^ self
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1033
        ].
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1034
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1035
    (depth == 1) ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1036
        ^ self on:aDevice
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1037
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1038
    ^ nil
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1039
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1040
    "Modified: 23.4.1996 / 10:18:42 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1041
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1042
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1043
on:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1044
    "associate the receiver to a device (i.e. download its bits);
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1045
     return a deviceForm (possibly different from the receiver)."
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1046
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1047
    aDevice == device ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1048
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1049
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1050
    "create a new form ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1051
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1052
    data notNil ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1053
        ^ self class width:width height:height fromArray:data on:aDevice
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1054
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1055
    fileName notNil ifTrue:[
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1056
        ^ self class fromFile:fileName on:aDevice
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1057
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1058
    ^ self width:width height:height on:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1059
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1060
    "Modified: 23.4.1996 / 10:18:05 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1061
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1062
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1063
!Form methodsFor:'image manipulations'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1064
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1065
darkened
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1066
    "return a darkened version of the receiver.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1067
     Added for protocol compatibility with Color and Image.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1068
     Here, the receiver is returned as a kludge 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1069
     - actually should return a darkened image (or Color black ?) .."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1070
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1071
    ^ self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1072
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1073
    "Modified: 23.4.1996 / 10:19:52 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1074
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1075
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1076
flipHorizontal
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1077
    "return a new form flipped horizontally"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1078
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1079
    |dstY newForm nRows "{ Class: SmallInteger }" |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1080
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1081
    newForm := ((self class) on:device)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1082
				width:width
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1083
				height:height
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1084
				depth:depth.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1085
    "expand rows"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1086
    dstY := height - 1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1087
    nRows := dstY // 2.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1088
    0 to:nRows do:[:srcY |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1089
	newForm copyFrom:self
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1090
		       x:0 y:srcY
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1091
		     toX:0 y:dstY
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1092
		   width:width height:1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1093
	dstY := dstY - 1
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1094
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1095
    newForm colorMap:localColorMap.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1096
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1097
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1098
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1099
flipVertical
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1100
    "return a new form flipped vertically"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1101
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1102
    |dstX newForm nCols "{ Class: SmallInteger }" |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1103
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1104
    newForm := ((self class) on:device)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1105
				width:width
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1106
				height:height
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1107
				depth:depth.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1108
    "expand cols"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1109
    dstX := width - 1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1110
    nCols := dstX // 2.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1111
    0 to:nCols do:[:srcX |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1112
	newForm copyFrom:self
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1113
		       x:srcX y:0
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1114
		     toX:dstX y:0
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1115
		   width:1 height:height.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1116
	dstX := dstX - 1
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1117
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1118
    newForm colorMap:localColorMap.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1119
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1120
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1121
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1122
hardMagnifiedBy:extent
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1123
    "return a new form magnified by extent, aPoint.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1124
     This method handles non-integral factors."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1125
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1126
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1127
     since Form will be replaced by Image in the long run,
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1128
     and this operation is slow anyway, use the implementation
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1129
     in Image for this."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1130
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1131
    ^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:device.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1132
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1133
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1134
     (Form fromFile:'OutputOn.64') magnifiedBy:0.5@0.5
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1135
     (Form fromFile:'OutputOn.64') magnifiedBy:1.5@1.5
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1136
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1137
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1138
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1139
lightened
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1140
    "return a lightened version of the receiver.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1141
     Added for protocol compatibility with Color and Image.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1142
     Here, the receiver is returned as a kludge 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1143
     - actually should return a lightened image (or Color white ?) .."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1144
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1145
    ^ self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1146
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1147
    "Modified: 23.4.1996 / 10:20:14 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1148
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1149
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1150
magnifiedBy:extent
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1151
    "return a new form magnified by extent, aPoint.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1152
     If non-integral magnify is asked for, pass the work on to 'hardMagnifiedBy:'"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1153
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1154
    |mX mY dstX dstY newForm ext 
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1155
     factor "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1156
     n      "{ Class: SmallInteger }" |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1157
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1158
    ext := extent asPoint.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1159
    mX := ext x.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1160
    mY := ext y.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1161
    ((mX = 1) and:[mY = 1]) ifTrue:[^ self].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1162
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1163
    ((mX isMemberOf:SmallInteger) and:[mY isMemberOf:SmallInteger]) ifFalse:[
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1164
	^ self hardMagnifiedBy:ext
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1165
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1166
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1167
    newForm := ((self class) on:device)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1168
				width:(width * mX)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1169
				height:(height * mY)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1170
				depth:depth.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1171
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1172
    "expand rows"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1173
    (mY > 1) ifTrue:[
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1174
	dstY := 0.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1175
	n := height.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1176
	factor := mY.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1177
	0 to:(n - 1) do:[:srcY |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1178
	    1 to:factor do:[:i |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1179
		newForm copyFrom:self
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1180
			       x:0 y:srcY
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1181
			     toX:0 y:dstY
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1182
			   width:width height:1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1183
		dstY := dstY + 1
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1184
	    ]
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1185
	]
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1186
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1187
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1188
    "expand cols"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1189
    (mX > 1) ifTrue:[
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1190
	n := width.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1191
	factor := mX.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1192
	dstX := (n * factor) - 1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1193
	(n - 1) to:0 by:-1 do:[:srcX |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1194
	    1 to:factor do:[:i |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1195
		newForm copyFrom:newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1196
			       x:srcX y:0
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1197
			     toX:dstX y:0
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1198
			   width:1 height:(height * mY).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1199
		dstX := dstX - 1
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1200
	    ]
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1201
	]
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1202
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1203
    newForm colorMap:localColorMap.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1204
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1205
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1206
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1207
     (ArrowButton upArrowButtonForm:#iris on:Display) magnifiedBy:(2 @ 2)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1208
     (Form fromFile:'bitmaps/SBrowser.xbm') magnifiedBy:(2 @ 2)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1209
     (Form fromFile:'bitmaps/SBrowser.xbm') magnifiedBy:(0.4 @ 0.4)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1210
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1211
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1212
569
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1213
magnifiedTo:anExtent 
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1214
    "return a new form magnified to have the size specified by extent.
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1215
     This may distort the image if the arguments ratio is not the images ratio.
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1216
     See also #magnifiedPreservingRatioTo: and #magnifiedBy:"
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1217
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1218
    ^ self magnifiedBy:(anExtent / self extent)
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1219
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1220
    "Created: 18.4.1996 / 16:17:52 / cg"
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1221
!
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1222
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1223
magnifyBy:scale
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1224
    "obsolete: has been renamed to magnifiedBy: for ST-80 compatibility
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1225
     and name consistency ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1226
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1227
    self obsoleteMethodWarning.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1228
    ^ self magnifiedBy:scale
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1229
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1230
48194c26a46c Initial revision
claus
parents:
diff changeset
  1231
!Form methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1232
48194c26a46c Initial revision
claus
parents:
diff changeset
  1233
initGC
48194c26a46c Initial revision
claus
parents:
diff changeset
  1234
    "stop server from sending exposure events for Forms -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1235
     (will fill up stream-queue on some stupid (i.e. sco) systems"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1236
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1237
    "/ depth-1 forms draw differently ...
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1238
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1239
    depth == 1 ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1240
        foreground isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1241
            foreground := paint := Color colorId:1.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1242
        ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1243
        background isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1244
            background := bgPaint := Color colorId:0
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1245
        ]
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1246
    ].
126
4fc31fd808c8 *** empty log message ***
claus
parents: 118
diff changeset
  1247
    super initGC.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1248
    self setGraphicsExposures:false
836
d6eb406b1c04 dither bitmaps moved to Color
Claus Gittinger <cg@exept.de>
parents: 789
diff changeset
  1249
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1250
    "Modified: 17.7.1996 / 13:21:24 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1251
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1252
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1253
initialize
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1254
    foreground := paint := Color colorId:1.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1255
    background := bgPaint := Color colorId:0.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1256
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1257
    super initialize.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1258
    depth := 1.
836
d6eb406b1c04 dither bitmaps moved to Color
Claus Gittinger <cg@exept.de>
parents: 789
diff changeset
  1259
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1260
"/    foreground isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1261
"/        foreground := Color colorId:1.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1262
"/    ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1263
"/    paint isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1264
"/        paint := foreground.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1265
"/    ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1266
"/    background isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1267
"/        background := Color colorId:0
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1268
"/    ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1269
"/    bgPaint isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1270
"/        bgPaint := background
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1271
"/    ]
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1272
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1273
    "Modified: 17.7.1996 / 13:02:01 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1274
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1275
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1276
recreate
48194c26a46c Initial revision
claus
parents:
diff changeset
  1277
    "reconstruct the form after a snapin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1278
48194c26a46c Initial revision
claus
parents:
diff changeset
  1279
    data notNil ifTrue:[
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1280
        "
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1281
         create one from data
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1282
        "
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1283
        (depth == 1 or:[depth == device depth]) ifTrue:[
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1284
            drawableId := device createBitmapFromArray:data width:width height:height.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1285
            Lobby registerChange:self. 
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1286
            drawableId notNil ifTrue:[
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1287
                ^ self
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1288
            ]
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1289
        ].
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1290
        'FORM: cannot recreate form' errorPrintCR.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1291
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1292
    fileName notNil ifTrue:[
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1293
        "
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1294
         create one from a file (mhmh - this seems X-specific and will vanish)
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1295
        "
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1296
        self readFromFile:fileName.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1297
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1298
"/        drawableId := device createBitmapFromFile:fileName for:self.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1299
"/        Lobby registerChange:self.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1300
        drawableId notNil ifTrue:[
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1301
            ^ self
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1302
        ].
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1303
        'FORM: cannot recreate file form: ' errorPrint. fileName errorPrintCR.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1304
    ].
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1305
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1306
    ^ self.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1307
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1308
    "
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1309
     create an empty one
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1310
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1311
    depth == 1 ifTrue:[
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1312
        drawableId := device createBitmapWidth:width height:height
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1313
    ] ifFalse:[
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1314
        drawableId := device createPixmapWidth:width height:height depth:device depth
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1315
    ].
162
claus
parents: 156
diff changeset
  1316
    Lobby registerChange:self
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1317
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1318
    "Modified: 15.6.1996 / 16:18:12 / cg"
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1319
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1320
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1321
!Form methodsFor:'inspecting'!
127
98b0725782bd *** empty log message ***
claus
parents: 126
diff changeset
  1322
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1323
inspectorClass
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1324
    "redefined to launch an ImageInspector
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1325
     (instead of the default InspectorView)."
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1326
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1327
    ^ ImageInspectorView
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1328
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1329
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1330
!Form methodsFor:'printing & storing'!
107
ef48048a8b34 *** empty log message ***
claus
parents: 99
diff changeset
  1331
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1332
storeOn:aStream
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1333
    "append an ascii representation of the receiver to aStream,
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1334
     from which a copy of the receiver can be reconstructed"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1335
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1336
    aStream nextPutAll:'(Form width:'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1337
    width storeOn:aStream.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1338
    aStream nextPutAll:' height:'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1339
    height storeOn:aStream.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1340
    aStream nextPutAll:' fromArray:('.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1341
    self bits storeOn:aStream.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1342
    aStream nextPutAll:'))'
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1343
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1344
    "Modified: 23.4.1996 / 10:21:10 / cg"
107
ef48048a8b34 *** empty log message ***
claus
parents: 99
diff changeset
  1345
! !
ef48048a8b34 *** empty log message ***
claus
parents: 99
diff changeset
  1346
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1347
!Form methodsFor:'private'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1348
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1349
beImmediateForm
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1350
    "read the pixels from the device into a local data array. 
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1351
     This makes certain that a fileName form is independent of
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1352
     its fileName.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1353
     To make the image smaller (i.e. not keep all those bitmaps),
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1354
     this is NOT done by default."
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1355
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1356
    data isNil ifTrue:[
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1357
        data := self bits.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1358
        data notNil ifTrue:[
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1359
            fileName := nil
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1360
        ]
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1361
    ]
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1362
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1363
    "
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1364
     Form allInstances:[:f |
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1365
        f beImmediateForm
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1366
     ]
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1367
    "
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1368
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1369
    "Created: 7.2.1996 / 16:04:18 / cg"
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1370
!
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1371
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1372
flushDeviceHandles
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1373
    "flush device handles (sent after a restart)"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1374
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1375
    drawableId := nil.
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1376
    gcId := nil.
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1377
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1378
    "Created: 15.6.1996 / 15:44:28 / cg"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1379
!
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1380
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1381
getBits
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1382
    "if the receiver was not created from a file, or
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1383
     an array (i.e. it was drawn), read the pixels from the
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1384
     device into a local data array. This has to be done before
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1385
     an image is saved, or the receiver is storedBinary, since
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1386
     the information present in the device is lost after restart/reload"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1387
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1388
    (data isNil and:[fileName isNil]) ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1389
	data := self bits
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1390
    ]
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1391
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1392
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1393
readFromFile:fn
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1394
    "read a monochrome form from a file (in xbm-format).
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1395
     The fileName argument, fn should be a relative pathname
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1396
     such as bitmaps/foo.xbm and the corresponding file
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1397
     will be searched in the standard places (i.e. along the SEARCHPATH).
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1398
     Notice, when saving an image, only that fileName is kept with the
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1399
     form, and the file is reloaded at image startup time.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1400
     You should therefore make certain, that the file is present at image
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1401
     reload time. (this is done to make the image smaller ...)
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1402
     If you dont like that behavior (or your application should be able to
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1403
     restart fully standAlone), send #beImmediateForm to all instances of
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1404
     Form - this will set the data instance variable to a ByteArray containing
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1405
     the actual bits and  will therefore no longer depend on the file being present.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1406
     "
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1407
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1408
    |pathName|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1409
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1410
    pathName := self class findBitmapFile:fn.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1411
    pathName notNil ifTrue:[
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1412
        drawableId := device createBitmapFromFile:pathName for:self.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1413
        drawableId isNil ifTrue:[^ nil].
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1414
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1415
"/        fileName := pathName. "/ keep the actual name (wrong)
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1416
        fileName := fn.         "/ keep the relative name (better - SEARCHPATH may be different at restart)
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1417
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1418
        offset := 0@0.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1419
        realized := true.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1420
        BlackAndWhiteColorMap isNil ifTrue:[
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1421
            BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1422
        ].
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1423
        localColorMap := BlackAndWhiteColorMap.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1424
        Lobby registerChange:self.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1425
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1426
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1427
    ^ nil
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1428
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1429
    "Modified: 7.2.1996 / 16:04:25 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1430
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1431
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1432
readFromFile:filename resolution:dpi
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1433
    "read a monochrome form from a file, which is assumed to have data for a dpi-resolution;
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1434
     if the actual resolution of the device differs, magnify the form.
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1435
     Read the comment in #readFromFile: on what happenes if the file is no longer present
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1436
     after an image reload."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1437
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1438
    |dpiH mag dev|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1439
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1440
    (self readFromFile:filename) isNil ifTrue:[^ nil].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1441
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1442
    "if the device is within +- 50% of dpi, no magnify is needed"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1443
    dev := device.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1444
    dev isNil ifTrue:[
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1445
        "should not happen ..."
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1446
        dev := Screen current
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1447
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1448
    dpiH := dev horizontalPixelPerInch.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1449
    ((dpi >= (dpiH * 0.75)) and:[dpi <= (dpiH * 1.5)]) ifTrue:[^ self].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1450
    mag := (dpiH / dpi) rounded.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1451
    mag == 0 ifTrue:[
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1452
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1453
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1454
    ^ self magnifiedBy:(mag @ mag)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1455
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1456
    "Form fromFile:'SBrowser.icn' resolution:50"
412
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1457
766ba454c23d keep the relative fileName; added #beImmediateForm to avoid problems if bitmap files are not present at startup
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1458
    "Modified: 7.2.1996 / 16:03:45 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1459
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1460
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1461
restored
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1462
    "flush device data, when restored (sent after a binaryLoad)"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1463
425
7e1df86e2517 flush device ref when restored
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
  1464
    device := nil.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1465
    drawableId := nil.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1466
    gcId := nil.
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1467
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1468
    "Modified: 15.6.1996 / 15:43:39 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1469
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1470
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1471
width:w height:h
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1472
    "actual create of a monochrome form"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1473
48194c26a46c Initial revision
claus
parents:
diff changeset
  1474
    ((w == 0) or:[h == 0]) ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1475
	self error:'invalid form extent'.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1476
	^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1477
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1478
    width := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1479
    height := h.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1480
    depth := 1.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1481
    offset := 0@0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1482
    drawableId := device createBitmapWidth:w height:h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1483
    drawableId isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1484
    BlackAndWhiteColorMap isNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1485
	BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1486
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1487
    localColorMap := BlackAndWhiteColorMap.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1488
    realized := true.
162
claus
parents: 156
diff changeset
  1489
    Lobby registerChange:self.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1490
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1491
48194c26a46c Initial revision
claus
parents:
diff changeset
  1492
width:w height:h depth:d
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1493
    "actual create of an arbitrary deep form (but, must be supported by device)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1494
48194c26a46c Initial revision
claus
parents:
diff changeset
  1495
    width := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1496
    height := h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1497
    offset := 0@0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1498
    drawableId := device createPixmapWidth:w height:h depth:d.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1499
    drawableId isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1500
    realized := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1501
    depth := d.
162
claus
parents: 156
diff changeset
  1502
    Lobby registerChange:self.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1503
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1504
48194c26a46c Initial revision
claus
parents:
diff changeset
  1505
width:w height:h fromArray:anArray
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1506
    "actual create of a monochrome form from array.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1507
     This method is somewhat more complicated as it should be due to 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1508
     supporting both byte-wise (ST/X-type) and short-word-wise (ST-80-type)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1509
     Arrays; in the later case, the shorts are first converted to bytes in
48194c26a46c Initial revision
claus
parents:
diff changeset
  1510
     a ByteArray, then passed to the device."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1511
134
claus
parents: 133
diff changeset
  1512
    |bytes bits 
claus
parents: 133
diff changeset
  1513
     srcPerRow "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1514
     dstPerRow "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1515
     srcStart  "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1516
     srcIndex  "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1517
     dstIndex  "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1518
     hi        "{ Class: SmallInteger }" |
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1519
48194c26a46c Initial revision
claus
parents:
diff changeset
  1520
    bytes := anArray.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1521
48194c26a46c Initial revision
claus
parents:
diff changeset
  1522
    anArray size ~~ (((w + 7) // 8) * h) ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1523
	anArray size == (((w + 15) // 16) * h) ifTrue:[
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1524
	    "I want the bytes but got shorts (ST-80)"
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1525
	    bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h).
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1526
	    srcPerRow := (w + 15) // 16.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1527
	    dstPerRow := (w + 7) // 8.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1528
	    srcStart := 1.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1529
	    dstIndex := 1.
134
claus
parents: 133
diff changeset
  1530
	    hi := h.
claus
parents: 133
diff changeset
  1531
	    1 to:hi do:[:hi |
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1532
		srcIndex := srcStart.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1533
		bits := anArray at:srcIndex.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1534
		1 to:dstPerRow do:[:di |
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1535
		    di odd ifTrue:[
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1536
			bits := anArray at:srcIndex.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1537
			bytes at:dstIndex put:(bits bitShift:-8)
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1538
		    ] ifFalse:[
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1539
			bytes at:dstIndex put:(bits bitAnd:16rFF).
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1540
			srcIndex := srcIndex + 1
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1541
		    ].
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1542
		    dstIndex := dstIndex + 1
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1543
		].
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1544
		srcStart := srcStart + srcPerRow
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1545
	    ]
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1546
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1547
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1548
    width := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1549
    height := h.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1550
    depth := 1.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1551
    offset := 0@0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1552
    drawableId := device createBitmapFromArray:bytes width:w height:h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1553
    drawableId isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1554
48194c26a46c Initial revision
claus
parents:
diff changeset
  1555
    data := bytes.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1556
    BlackAndWhiteColorMap isNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1557
	BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1558
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1559
    localColorMap := BlackAndWhiteColorMap.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1560
    realized := true.
162
claus
parents: 156
diff changeset
  1561
    Lobby registerChange:self.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1562
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1563
48194c26a46c Initial revision
claus
parents:
diff changeset
  1564
width:w height:h offset:offs fromArray:anArray
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1565
    "actual create of a monochrome form from array"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1566
48194c26a46c Initial revision
claus
parents:
diff changeset
  1567
    self width:w height:h fromArray:anArray.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1568
    offset := offs
48194c26a46c Initial revision
claus
parents:
diff changeset
  1569
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1570
99
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1571
!Form methodsFor:'queries '!
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1572
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1573
bounds
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1574
    "return my bounds (added to make forms usable as VisualComponents)"
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1575
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1576
    ^ Rectangle left:0 top:0 width:width height:height
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1577
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1578
    "Modified: 13.5.1996 / 10:26:13 / cg"
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1579
!
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1580
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1581
colorFromValue:pixel
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1582
    localColorMap notNil ifTrue:[
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1583
        ^ localColorMap at:(pixel + 1)
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1584
    ].
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1585
    depth == 1 ifTrue:[
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1586
        pixel == 0 ifTrue:[^ White].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1587
        ^ Black
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1588
    ].
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1589
    ^ Black
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1590
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1591
    "Created: 28.6.1996 / 16:10:13 / cg"
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1592
    "Modified: 17.7.1996 / 13:05:59 / cg"
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1593
!
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1594
925
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1595
hasBits
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1596
    "return true, if the receiver has its pixel data available.
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1597
     For forms, which were created from data, this is always true.
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1598
     For forms, which were created as off-screen device forms on some
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1599
     device, this is always false."
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1600
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1601
    ^ data notNil
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1602
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1603
    "Created: 5.7.1996 / 16:21:20 / cg"
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1604
!
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1605
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1606
heightOn:aGC
674
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1607
    "return my height, if displayed on aGC;
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1608
     since my height is independent of the device (the number of pixels),
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1609
     return the pixel-height"
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1610
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1611
    ^ height
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1612
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1613
    "Created: 12.5.1996 / 21:35:33 / cg"
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1614
    "Modified: 13.5.1996 / 10:26:09 / cg"
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1615
!
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1616
99
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1617
isForm
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1618
    "return true, if the receiver is some kind of form;
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1619
     true is returned here - the method is redefined from Object."
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1620
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1621
    ^ true
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1622
!
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1623
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1624
isImageOrForm
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1625
    "return true, if the receiver is some kind of image or form;
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1626
     true is returned here - the method is redefined from Object."
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1627
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1628
    ^ true
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1629
!
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1630
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1631
widthOn:aGC
674
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1632
    "return my width, if displayed on aGC;
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1633
     since my width is independent of the device (the number of pixels),
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1634
     return the pixel-width"
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1635
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1636
    ^ width
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1637
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1638
    "Created: 12.5.1996 / 21:35:29 / cg"
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1639
    "Modified: 13.5.1996 / 10:26:05 / cg"
99
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1640
! !
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1641
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1642
!Form  class methodsFor:'documentation'!
134
claus
parents: 133
diff changeset
  1643
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1644
version
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1645
    ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.62 1996-07-17 12:19:00 cg Exp $'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1646
! !
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1647
Form initialize!