Form.st
author Claus Gittinger <cg@exept.de>
Wed, 12 Jan 2000 16:18:15 +0100
changeset 3135 f9304f22f07b
parent 3106 d6333a2bd850
child 3142 4b5c726c0630
permissions -rw-r--r--
handle the case, where not Screen is available
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
1907
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    22
DeviceHandle subclass:#DeviceFormHandle
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    23
	instanceVariableNames:''
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    24
	classVariableNames:''
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    25
	poolDictionaries:''
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    26
	privateIn:Form
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    27
!
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
    28
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
    29
!Form class methodsFor:'documentation'!
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    30
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    31
copyright
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    32
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    33
 COPYRIGHT (c) 1989 by Claus Gittinger
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
    34
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    35
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    36
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    37
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    38
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    39
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    40
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    41
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    42
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    43
!
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    44
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    45
documentation
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    46
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    47
    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
    48
    which can be created on a drawing device. 
fc18ba574a4d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    49
    In X, these device resources are XPixmaps.
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    50
    Not all devices will support forms.
134
claus
parents: 133
diff changeset
    51
claus
parents: 133
diff changeset
    52
    NOTICE:
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    53
	the Form class is a historic leftover and now only used for real
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    54
	device forms (i.e. on devices which support downloading bitmaps).
590
fc18ba574a4d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 589
diff changeset
    55
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    56
	In your application, you should always use Image, both for compatibility
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    57
	with ST-80 and for device independence, since Form may not be supported
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    58
	by all devices.
589
2c119dc32f8c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
    59
935
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    60
    WARNING:
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    61
	Forms created on some device may not be recreatable, when an
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    62
	image is restarted on a display with different display capabilities.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    63
	For example, a 24bit truecolor form will be lost when the image is
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    64
	saved and restarted in an 8bit or monochrome display.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    65
	Worse: the information is completely lost.
935
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    66
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    67
	With images, the original information is always preserved, although
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    68
	the display may be with less resolution, dithered or otherwise
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    69
	approximated.
935
e71b1be3eb6c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
    70
591
d071af7739db commentary
Claus Gittinger <cg@exept.de>
parents: 590
diff changeset
    71
    [See also:]
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    72
	Image DeviceDrawable
610
f6951a01350f documentation
Claus Gittinger <cg@exept.de>
parents: 594
diff changeset
    73
f6951a01350f documentation
Claus Gittinger <cg@exept.de>
parents: 594
diff changeset
    74
    [author:]
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    75
	Claus Gittinger
46
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    76
"
7b331e9012fd *** empty log message ***
claus
parents: 35
diff changeset
    77
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    78
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
    79
!Form class methodsFor:'initialization'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    80
889
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    81
flushDeviceForms
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    82
    "recreate all forms on aDevice; called by Workstation, to
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    83
     have all background bitmaps at hand, when views are restored"
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
    Lobby do:[:aDrawable |
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    86
	aDrawable isForm ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    87
	    (aDrawable graphicsDevice notNil) ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    88
		"now, try to recreate it"
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    89
		aDrawable recreate.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    90
	    ]
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
    91
	]
889
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    92
    ]
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    93
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    94
    "Created: 18.6.1996 / 13:04:59 / cg"
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
    95
    "Modified: 5.7.1996 / 17:56:02 / cg"
889
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    96
!
253efa13c75b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 872
diff changeset
    97
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    98
initialize
126
4fc31fd808c8 *** empty log message ***
claus
parents: 118
diff changeset
    99
    "initialize set of dictionaries to look for bitmaps"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   100
48194c26a46c Initial revision
claus
parents:
diff changeset
   101
    AdditionalBitmapDirectoryNames isNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   102
	AdditionalBitmapDirectoryNames := #('/usr/lib/X11/bitmaps').
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   103
    
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   104
	"want to be informed when returning from snapshot"
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   105
	ObjectMemory addDependent:self.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   106
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   107
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   108
48194c26a46c Initial revision
claus
parents:
diff changeset
   109
reinitializeAllOn:aDevice
48194c26a46c Initial revision
claus
parents:
diff changeset
   110
    "recreate all forms on aDevice; called by Workstation, to
48194c26a46c Initial revision
claus
parents:
diff changeset
   111
     have all background bitmaps at hand, when views are restored"
48194c26a46c Initial revision
claus
parents:
diff changeset
   112
127
98b0725782bd *** empty log message ***
claus
parents: 126
diff changeset
   113
    Lobby do:[:aDrawable |
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
   114
	(aDrawable graphicsDevice == aDevice) ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
   115
	    aDrawable isForm ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
   116
		"now, try to recreate it"
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
   117
		aDrawable recreate.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
   118
	    ]
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
   119
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   120
    ]
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   121
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 925
diff changeset
   122
    "Modified: 5.7.1996 / 17:55:58 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   123
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   124
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   125
update:something with:aParameter from:changedObject
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   126
    "sent just before snapOut and just after a snapIn"
48194c26a46c Initial revision
claus
parents:
diff changeset
   127
48194c26a46c Initial revision
claus
parents:
diff changeset
   128
    (something == #save) ifTrue:[
2823
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   129
        "get all bits from the device into saveable arrays"
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   130
        Lobby do:[:aDrawable |
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   131
            aDrawable isForm ifTrue:[
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   132
                PrimitiveFailureSignal handle:[:ex |
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   133
                    'Form [warning]: cannot fetch form bits from device' errorPrintCR
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   134
                ] do:[
2933
fd5033d6a182 ask device, if it wants to be made persistent in the snapshot image
Claus Gittinger <cg@exept.de>
parents: 2850
diff changeset
   135
                    |dev|
fd5033d6a182 ask device, if it wants to be made persistent in the snapshot image
Claus Gittinger <cg@exept.de>
parents: 2850
diff changeset
   136
fd5033d6a182 ask device, if it wants to be made persistent in the snapshot image
Claus Gittinger <cg@exept.de>
parents: 2850
diff changeset
   137
                    ((dev := aDrawable device) isNil   
fd5033d6a182 ask device, if it wants to be made persistent in the snapshot image
Claus Gittinger <cg@exept.de>
parents: 2850
diff changeset
   138
                    or:[dev isPersistentInSnapshot]) ifTrue:[
fd5033d6a182 ask device, if it wants to be made persistent in the snapshot image
Claus Gittinger <cg@exept.de>
parents: 2850
diff changeset
   139
                        aDrawable getBits
fd5033d6a182 ask device, if it wants to be made persistent in the snapshot image
Claus Gittinger <cg@exept.de>
parents: 2850
diff changeset
   140
                    ]
2823
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   141
                ]
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   142
            ]
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   143
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   144
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   145
    (something == #restarted) ifTrue:[
2823
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   146
        "remove all left-over device info"
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   147
        Lobby do:[:aDrawable |
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   148
            aDrawable isForm ifTrue:[
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   149
                aDrawable flushDeviceHandles.
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   150
                Lobby registerChange:aDrawable 
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   151
            ]
c10e30bad607 catch form-fetch bit error during save
Claus Gittinger <cg@exept.de>
parents: 2773
diff changeset
   152
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   153
    ]
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   154
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   155
    "Modified: 15.6.1996 / 15:44:09 / cg"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
   156
    "Created: 15.6.1996 / 15:47:50 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   157
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   158
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   159
!Form class methodsFor:'instance creation'!
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   160
2964
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   161
dotOfSize:size
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   162
    "create and return a form which contains a dot (filled circle)
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   163
     of the given size."
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   164
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   165
    |f|
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   166
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   167
    f := self extent:size asPoint on:Screen current.
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   168
    f clear.
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   169
    f fillCircle:(f center) radius:(f width min:f height) // 2.
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   170
    ^ f
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   171
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   172
    "
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   173
     (Form dotOfSize:8) inspect
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   174
     (Form dotOfSize:20) inspect
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   175
    "
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   176
!
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   177
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   178
extent:ext
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   179
    "create a new, cleared form, take dimensions from ext.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   180
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   181
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   182
    |newForm|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   183
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   184
    newForm := self width:(ext x) height:(ext y).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   185
    newForm fill:(Color colorId:0).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   186
    newForm paint:(Color colorId:1).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   187
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   188
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   189
1278
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   190
extent:ext depth:d
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   191
    "create a new, cleared form.
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   192
     Smalltalk-80 compatibility"
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   193
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   194
    ^ self width:ext x height:ext y depth:d
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   195
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   196
    "Created: 27.1.1997 / 16:08:37 / cg"
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   197
    "Modified: 27.1.1997 / 16:08:50 / cg"
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   198
!
85b4c4898265 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1255
diff changeset
   199
1548
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   200
extent:ext depth:d on:aDevice
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   201
    "create a new form on device, aDevice; depth is what device likes most"
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   202
1549
b5becd3e5f6f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1548
diff changeset
   203
    ^ self width:ext x height:ext y depth:d on:aDevice
1548
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   204
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   205
    "Created: 4.4.1997 / 20:23:32 / cg"
1549
b5becd3e5f6f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1548
diff changeset
   206
    "Modified: 4.4.1997 / 20:25:28 / cg"
1548
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   207
!
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   208
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   209
extent:ext fromArray:data
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   210
    "create a new form, take dimensions from ext, bits from data.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   211
     Smalltalk-80 compatibility."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   212
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   213
    ^ 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
   214
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   215
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   216
extent:ext fromArray:data offset:offs
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   217
    "create a new form, take dimensions from ext, bits from data.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   218
     Smalltalk-80 compatibility."
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
    ^ self width:(ext x) height:(ext y) offset:offs fromArray:data
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   221
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   222
1571
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   223
extent:ext fromArray:data offset:offs on:aDevice
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   224
    "create a new form, take dimensions from ext, bits from data."
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   225
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   226
    ^ self width:(ext x) height:(ext y) offset:offs fromArray:data on:aDevice
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   227
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   228
    "Created: 10.4.1997 / 15:36:31 / cg"
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   229
!
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   230
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   231
extent:ext fromArray:data on:aDevice
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   232
    "create a new form, take dimensions from ext, bits from data."
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   233
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   234
    ^ self width:(ext x) height:(ext y) fromArray:data on:aDevice
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   235
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   236
    "Created: 10.4.1997 / 15:34:34 / cg"
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   237
    "Modified: 10.4.1997 / 15:36:04 / cg"
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   238
!
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   239
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   240
extent:ext offset:anOffset
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   241
    "create a new, cleared form, take dimensions from ext.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   242
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   243
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   244
    ^ (self extent:ext) offset:anOffset.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   245
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   246
1548
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   247
extent:ext on:aDevice
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   248
    "create a new form on device, aDevice; depth is what device likes most"
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   249
1549
b5becd3e5f6f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1548
diff changeset
   250
    ^ self width:ext x height:ext y on:aDevice
1548
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   251
1549
b5becd3e5f6f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1548
diff changeset
   252
    "Modified: 4.4.1997 / 20:25:07 / cg"
1548
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   253
!
34a5a4e5a1c5 protocol completeness
Claus Gittinger <cg@exept.de>
parents: 1520
diff changeset
   254
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   255
width:w height:h
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   256
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   257
3135
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   258
    |scr|
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   259
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   260
    Screen notNil ifTrue:[scr := Screen current].
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   261
    ^ self width:w height:h on:scr
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   262
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   263
    "Modified: 4.6.1996 / 22:16:33 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   264
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   265
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   266
width:w height:h depth:d
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   267
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   268
3135
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   269
    |scr|
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   270
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   271
    Screen notNil ifTrue:[scr := Screen current].
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   272
    ^ self width:w height:h depth:d on:scr
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   273
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   274
    "Modified: 4.6.1996 / 22:16:51 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   275
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   276
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   277
width:w height:h depth:d on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   278
    "create a new form with depth d on device, aDevice"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   279
1255
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   280
    ^ (self onDevice:aDevice) width:w height:h depth:d
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   281
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   282
    "Modified: 18.1.1997 / 18:26:03 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   283
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   284
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   285
width:w height:h fromArray:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   286
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   287
3135
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   288
    |scr|
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   289
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   290
    Screen notNil ifTrue:[scr := Screen current].
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   291
    ^ self width:w height:h fromArray:anArray on:scr
789
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   292
9566544d68a1 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 746
diff changeset
   293
    "Modified: 4.6.1996 / 22:17:05 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   294
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   295
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   296
width:w height:h fromArray:anArray on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   297
    "create a new form on device, aDevice and
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   298
     initialize the pixels from anArray"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   299
1255
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   300
    ^ (self onDevice:aDevice) width:w height:h fromArray:anArray
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   301
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   302
    "Modified: 18.1.1997 / 18:26:24 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   303
!
109
ba47d9d6bda8 *** empty log message ***
claus
parents: 107
diff changeset
   304
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   305
width:w height:h offset:offs fromArray:anArray
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   306
    "create a new form on the default device"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   307
3135
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   308
    |scr|
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   309
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   310
    Screen notNil ifTrue:[scr := Screen current].
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
   311
    ^ self width:w height:h offset:offs fromArray:anArray on:scr
1255
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   312
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   313
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   314
1571
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   315
width:w height:h offset:offs fromArray:anArray on:aDevice
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   316
    "create a new form on the default device"
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   317
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   318
    ^ (self onDevice:aDevice) width:w height:h offset:offs fromArray:anArray
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   319
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   320
    "Modified: 18.1.1997 / 18:26:28 / cg"
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   321
    "Created: 10.4.1997 / 15:35:07 / cg"
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   322
!
262706c010ed checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1549
diff changeset
   323
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   324
width:w height:h on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   325
    "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
   326
1255
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   327
    ^ (self onDevice:aDevice) width:w height:h
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   328
bdf4cbcae668 on: -> onDevice:
Claus Gittinger <cg@exept.de>
parents: 1200
diff changeset
   329
    "Modified: 18.1.1997 / 18:26:31 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   330
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   331
3020
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   332
!Form class methodsFor:'Compatibility - Squeak'!
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   333
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   334
extent:ext depth:d fromArray:data offset:offs
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   335
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   336
    d ~~ 1 ifTrue:[self halt:'unsupported depth'].       
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   337
    ^self width:(ext x) height:(ext y) offset:offs fromArray:data
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   338
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   339
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   340
! !
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   341
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   342
!Form class methodsFor:'ST-80 compatibility'!
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   343
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   344
and
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   345
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   346
     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
   347
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   348
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   349
    ^ #and
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   350
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   351
    "Modified: 2.5.1996 / 11:41:23 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   352
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   353
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   354
black
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   355
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   356
     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
   357
     - here we return the black color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   358
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   359
    ^ Color black
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   360
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   361
    "Modified: 2.5.1996 / 11:44:17 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   362
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   363
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   364
darkGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   365
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   366
     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
   367
     - here we return the darkGray color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   368
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   369
    ^ Color darkGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   370
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   371
    "Modified: 2.5.1996 / 11:44:06 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   372
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   373
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   374
darkGrey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   375
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   376
     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
   377
     - here we return the darkGrey color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   378
746
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   379
    ^ Color darkGray
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   380
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   381
    "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
   382
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   383
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   384
gray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   385
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   386
     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
   387
     - here we return the grey color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   388
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   389
    ^ Color gray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   390
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   391
    "Modified: 2.5.1996 / 11:43:44 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   392
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   393
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   394
grey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   395
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   396
     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
   397
     - here we return the grey color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   398
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   399
    ^ Color grey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   400
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   401
    "Modified: 2.5.1996 / 11:43:17 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   402
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   403
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   404
lightGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   405
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   406
     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
   407
     - here we return the lightGray color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   408
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   409
    ^ Color lightGray
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   410
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   411
    "Created: 2.5.1996 / 11:40:07 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   412
    "Modified: 2.5.1996 / 11:43:21 / cg"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   413
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   414
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   415
lightGrey
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   416
    "ST80 compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   417
     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
   418
     - here we return the lightGray color."
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   419
746
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   420
    ^ Color lightGray
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   421
f5479d603f64 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
   422
    "Modified: 28.5.1996 / 20:53:28 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   423
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   424
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   425
over
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   426
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   427
     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
   428
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   429
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   430
    ^ #copy
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   431
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   432
    "Modified: 2.5.1996 / 11:41:31 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   433
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   434
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   435
paint
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   436
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   437
     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
   438
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   439
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   440
    ^ #copy
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   441
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   442
    "Modified: 2.5.1996 / 11:41:40 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   443
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   444
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   445
reverse
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   446
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   447
     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
   448
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   449
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   450
    ^ #xor
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   451
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   452
    "Modified: 2.5.1996 / 11:41:45 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   453
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   454
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   455
under
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   456
    "return a constant usable as bitblt-combinationrule.
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   457
     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
   458
     these are symbolic."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   459
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   460
    ^ #or
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   461
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   462
    "Modified: 2.5.1996 / 11:41:49 / cg"
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
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   465
white
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   466
    "ST80rel2.x compatibility;
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   467
     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
   468
     - here we return the white color."
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
    ^ Color white
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   471
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   472
    "Modified: 2.5.1996 / 11:42:50 / cg"
109
ba47d9d6bda8 *** empty log message ***
claus
parents: 107
diff changeset
   473
! !
ba47d9d6bda8 *** empty log message ***
claus
parents: 107
diff changeset
   474
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   475
!Form class methodsFor:'cleanup'!
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   476
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   477
lowSpaceCleanup
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   478
    "cleanup in low-memory situations"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   479
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   480
    DitherPatternArray := nil
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   481
! !
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   482
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   483
!Form class methodsFor:'file search'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   484
48194c26a46c Initial revision
claus
parents:
diff changeset
   485
findBitmapFile:fileName
48194c26a46c Initial revision
claus
parents:
diff changeset
   486
    "find the bitmap file in one of the standard places;
48194c26a46c Initial revision
claus
parents:
diff changeset
   487
     return the pathName or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   488
48194c26a46c Initial revision
claus
parents:
diff changeset
   489
    |aStream path|
48194c26a46c Initial revision
claus
parents:
diff changeset
   490
48194c26a46c Initial revision
claus
parents:
diff changeset
   491
    ((fileName at:1) == $/) ifTrue:[^ fileName].
48194c26a46c Initial revision
claus
parents:
diff changeset
   492
    (fileName startsWith:'../') ifTrue:[^ fileName].
48194c26a46c Initial revision
claus
parents:
diff changeset
   493
    (fileName startsWith:'./') ifTrue:[^ fileName].
127
98b0725782bd *** empty log message ***
claus
parents: 126
diff changeset
   494
    fileName asFilename exists ifTrue:[^ fileName].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   495
134
claus
parents: 133
diff changeset
   496
    aStream := Smalltalk bitmapFileStreamFor:fileName.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   497
    aStream notNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   498
	path := aStream pathName.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   499
	aStream close.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   500
	^ path
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   501
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   502
    AdditionalBitmapDirectoryNames notNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   503
	AdditionalBitmapDirectoryNames do:[:aPath |
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   504
	    path := aPath , '/' , fileName.
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   505
	    (OperatingSystem isReadable:path) ifTrue:[
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   506
		^ path
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   507
	    ]
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
   508
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   509
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   510
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   511
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   512
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   513
!Form class methodsFor:'fileIn/Out'!
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   514
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   515
fromFile:filename
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   516
    "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
   517
     WARNING:
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   518
     Please do no longer use this, since it will not work
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   519
     correctly in multi-display applications (creates the form on the
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   520
     default Display).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   521
     Use #fromFile:on: and pass the devive as argument."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   522
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   523
    self obsoleteMethodWarning:'please use Image>>fromFile:'.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   524
    ^ self fromFile:filename on:Screen current
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   525
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   526
    "Modified: 19.12.1996 / 13:59:09 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   527
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   528
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   529
fromFile:filename on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   530
    "create a new form on device, aDevice and
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   531
     initialize the pixels from the file filename"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   532
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   533
    self obsoleteMethodWarning:'please use Image>>fromFile:'.
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
   534
    ^ (self onDevice:aDevice) readFromFile:filename
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   535
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
   536
    "Modified: 5.6.1997 / 21:05:59 / cg"
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   537
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   538
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   539
fromFile:filename resolution:dpi
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   540
    "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
   541
     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
   542
     if it is different from the displays resolution, magnify or
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   543
     shrink the picture (but only in integer magnification steps).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   544
     WARNING:
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   545
     Please do no longer use this, since it will not work
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   546
     correctly in multi-display applications (creates the form on the
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   547
     default Display).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   548
     Use #fromFile:resolution:on: and pass the devive as argument."
98
cd6af625d477 *** empty log message ***
claus
parents: 89
diff changeset
   549
1145
d3dc78117036 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1142
diff changeset
   550
    self obsoleteMethodWarning:'please use Image>>fromFile:'.
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
   551
    ^ (self onDevice:Screen current) readFromFile:filename resolution:dpi
1145
d3dc78117036 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1142
diff changeset
   552
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
   553
    "Modified: 5.6.1997 / 21:06:03 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   554
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   555
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   556
fromFile:filename resolution:dpi on:aDevice
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   557
    "create a new form on device, aDevice and
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   558
     initialize the pixels from the file filename;
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   559
     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
   560
     if it is different from the displays resolution, magnify or
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   561
     shrink the picture (but only in integer magnification steps)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   562
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   563
    self obsoleteMethodWarning:'please use Image>>fromFile:'.
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
   564
    ^ (self onDevice:aDevice) readFromFile:filename resolution:dpi
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   565
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
   566
    "Modified: 5.6.1997 / 21:05:54 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   567
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   568
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   569
readFrom:fileName
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   570
    "same as Form>>fromFile: - for ST-80 compatibility.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   571
     WARNING:
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   572
     Please do no longer use this, since it will not work
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   573
     correctly in multi-display applications (creates the form on the
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   574
     default Display).
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   575
     Use #fromFile:on: and pass the devive as argument."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   576
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   577
    self obsoleteMethodWarning:'please use Image>>fromFile:'.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   578
    ^ self fromFile:fileName on:Screen current
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   579
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   580
    "Modified: 19.12.1996 / 13:59:50 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   581
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   582
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   583
!Form class methodsFor:'obsolete instance creation'!
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   584
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   585
darkGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   586
    "return a darkGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   587
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   588
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   589
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   590
    ((aDevice == Display) and:[DarkGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   591
	^ DarkGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   592
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   593
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   594
    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
   595
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   596
	DarkGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   597
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   598
    ^ f
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
grey:percent on:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   602
    "return a form for dithering"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   603
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
   604
    (percent < 20) ifTrue:[^ Color black onDevice:aDevice].
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   605
    (percent < 40) ifTrue:[^ self darkGreyFormOn:aDevice].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   606
    (percent < 60) ifTrue:[^ self mediumGreyFormOn:aDevice].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   607
    (percent < 80) ifTrue:[^ self lightGreyFormOn:aDevice].
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
   608
    ^ Color white onDevice:aDevice
632
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
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   611
lightGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   612
    "return a lightGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   613
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   614
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   615
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   616
    ((aDevice == Display) and:[LightGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   617
	^ LightGreyForm
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
    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
   621
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   622
	LightGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   623
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   624
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   625
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   626
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   627
mediumGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   628
    "return a grey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   629
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   630
    |f|
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
    ((aDevice == Display) and:[GreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   633
	^ GreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   634
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   635
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   636
    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
   637
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   638
	GreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   639
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   640
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   641
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   642
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   643
veryDarkGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   644
    "return a veryDarkGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   645
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   646
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   647
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   648
    ((aDevice == Display) and:[VeryDarkGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   649
	^ VeryDarkGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   650
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   651
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   652
    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
   653
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   654
	VeryDarkGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   655
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   656
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   657
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   658
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   659
veryLightGreyFormOn:aDevice
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   660
    "return a veryLightGrey form"
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   661
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   662
    |f|
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   663
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   664
    ((aDevice == Display) and:[VeryLightGreyForm notNil]) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   665
	^ VeryLightGreyForm
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   666
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   667
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   668
    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
   669
    (aDevice == Display) ifTrue:[
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   670
	VeryLightGreyForm := f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   671
    ].
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   672
    ^ f
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   673
! !
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   674
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
   675
!Form class methodsFor:'obsolete patterns'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   676
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   677
darkGreyFormBits
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   678
    "return a pattern usable to simulate darkGray on monochrome device"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   679
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   680
    ^ #(2r10111011
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   681
	2r11101110
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   682
	2r10111011
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   683
	2r11101110)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   684
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   685
632
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   686
grey12Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   687
    "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
   688
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   689
    ^ #(2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   690
	2r00000000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   691
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   692
	2r00000000)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   693
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   694
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   695
grey25Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   696
    "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
   697
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   698
    ^ #(2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   699
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   700
	2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   701
	2r01000100)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   702
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   703
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   704
grey37Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   705
    "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
   706
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   707
    ^ #(2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   708
	2r10101010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   709
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   710
	2r10101010)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   711
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   712
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   713
grey50Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   714
    "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
   715
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   716
    ^ #(2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   717
	2r10101010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   718
	2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   719
	2r10101010)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   720
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   721
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   722
grey6Bits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   723
    "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
   724
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   725
    ^ #(2r00000001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   726
	2r00000000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   727
	2r00010000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   728
	2r00000000)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   729
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   730
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   731
greyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   732
    "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
   733
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   734
    ^ #(2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   735
	2r10101010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   736
	2r01010101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   737
	2r10101010)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   738
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   739
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   740
lightGreyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   741
    "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
   742
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   743
    ^ #(2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   744
	2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   745
	2r01000100
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   746
	2r00010001
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   747
	2r01000100)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   748
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   749
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   750
veryDarkGreyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   751
    "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
   752
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   753
    ^ #(2r01110111
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   754
	2r11111111
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   755
	2r11011101
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   756
	2r11111111)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   757
!
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   758
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   759
veryLightGreyFormBits
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   760
    "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
   761
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   762
    ^ #(2r10001000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   763
	2r00000000
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   764
	2r00100010
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   765
	2r00000000)
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   766
! !
28cbc6517090 marked some obsolete; grey/gray (sigh)
Claus Gittinger <cg@exept.de>
parents: 610
diff changeset
   767
2939
1df256ac509e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2933
diff changeset
   768
!Form methodsFor:'Compatibility - ST-80'!
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   769
1520
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   770
destroy
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   771
    "destroy my underlying device resource(s)"
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
   772
1520
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   773
    |id|
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   774
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   775
    (id := gcId) notNil ifTrue:[
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   776
        gcId := nil.
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   777
        device destroyGC:id.
1508
5d9b6b2524c9 release device resource in close.
Claus Gittinger <cg@exept.de>
parents: 1498
diff changeset
   778
    ].
5d9b6b2524c9 release device resource in close.
Claus Gittinger <cg@exept.de>
parents: 1498
diff changeset
   779
1520
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   780
    (id := drawableId) notNil ifTrue:[
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   781
        drawableId := nil.
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   782
        device destroyPixmap:id.
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   783
    ].
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   784
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   785
    Lobby unregister:self.
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   786
bc88c7620d72 #close moved up.
Claus Gittinger <cg@exept.de>
parents: 1508
diff changeset
   787
    "Modified: 2.4.1997 / 19:39:52 / cg"
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
   788
!
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
   789
2964
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   790
displayAt:aPoint
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   791
    "show the receiver on the current display screen"
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   792
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   793
    self displayOn:Screen current rootView at:aPoint
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   794
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   795
    "
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   796
     (Form dotOfSize:8) displayAt:10@10
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   797
    "
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   798
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   799
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   800
!
d9b5700dbfda checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2939
diff changeset
   801
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   802
displayOn:aGC at:aPoint
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   803
    "draw in aGC.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   804
     Smalltalk-80 (2.x) compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   805
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   806
    ^ self displayOn:aGC x:aPoint x y:aPoint y rule:#copy
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   807
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   808
    "Modified: 12.5.1996 / 20:16:15 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   809
!
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
displayOn:aGC at:aPoint rule:rule
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   812
    "draw in aGC.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   813
     Smalltalk-80 (2.x) compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   814
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   815
    self displayOn:aGC x:aPoint x y:aPoint y rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   816
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   817
    "Modified: 12.5.1996 / 20:16:02 / cg"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   818
!
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   819
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   820
displayOn:aGC rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   821
    "draw in aGC.
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   822
     Smalltalk-80 (2.x) compatibility"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   823
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   824
    ^ self displayOn:aGC x:0 y:0 rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   825
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   826
    "Modified: 12.5.1996 / 20:15:41 / cg"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   827
!
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   828
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   829
displayOn:aGC x:x y:y
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   830
    "draw in aGC.
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   831
     Smalltalk-80 (2.x) compatibility"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   832
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   833
    ^ self displayOn:aGC x:x y:y rule:#copy
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   834
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   835
    "Created: 12.5.1996 / 20:15:05 / cg"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   836
!
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   837
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   838
displayOn:aGC x:x y:y rule:rule
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   839
    "draw in aGC.
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   840
     Smalltalk-80 (2.x) compatibility"
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   841
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   842
    |f|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   843
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   844
    f := aGC function.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   845
    aGC function:rule.
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   846
    aGC displayOpaqueForm:self x:x y:y.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   847
    aGC function:f.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   848
672
01d7c8b9d2e7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 632
diff changeset
   849
    "Created: 12.5.1996 / 20:15:26 / cg"
278
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
1325
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   852
isOpen
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   853
    ^ true
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   854
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   855
    "Created: 10.2.1997 / 12:43:49 / cg"
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   856
!
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   857
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   858
offset
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   859
    "set the offset.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   860
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   861
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   862
    ^ offset
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   863
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   864
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   865
offset:org
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   866
    "set the offset.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   867
     Smalltalk-80 compatibility"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   868
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   869
    offset := org
1325
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   870
!
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   871
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   872
preferredBounds
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   873
    ^ self bounds
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   874
3c09b139de30 more st80 compatibility
Claus Gittinger <cg@exept.de>
parents: 1278
diff changeset
   875
    "Created: 10.2.1997 / 12:43:00 / cg"
278
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
3020
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   878
!Form methodsFor:'Compatibility - Squeak'!
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   879
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   880
colormapIfNeededForDepth:destDepth
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   881
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   882
    ^nil
3025
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   883
!
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   884
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   885
copyBits:aRectangle from:aForm at:srcOrigin clippingBox:clippingBox rule:rule fillColor:fillColor
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   886
    rule == Form over ifTrue:[
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   887
        self clippingRectangle:clippingBox.
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   888
        self 
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   889
            copyFrom:aForm 
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   890
            x:srcOrigin x y:srcOrigin y 
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   891
            toX:aRectangle left y:aRectangle top
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   892
            width:aRectangle width height:aRectangle height.
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   893
        ^ self
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   894
    ].
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   895
    self halt.
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   896
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   897
!
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   898
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   899
magnify:aRectangle by:scale smoothing:smooth
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
   900
    ^ ((Image fromSubForm:aRectangle in:self) magnifiedBy:scale) asFormOn:device.
3020
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   901
! !
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
   902
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   903
!Form methodsFor:'accessing'!
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
bits
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   906
    "return a ByteArray filled with my bits -
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   907
     for depth 8 forms, 1 pixel/byte is filled;
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   908
     for depth 1 forms, 8 pixels/byte are filled
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   909
     for depth 4 forms, 2 pixels/byte are filled.
1645
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   910
     Padding is done row-wise to the next BYTE-boundary 
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   911
     If multiple pixels are contained in a single byte,
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   912
     left bits are in the most significant bit positions.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   913
     (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
   914
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   915
    |bytesPerLine   "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   916
     bytesPerLineIn "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   917
     inData tmpData info
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   918
     srcIndex "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   919
     dstIndex "{ Class: SmallInteger }"
2060
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   920
     buffer spaceBitsPerPixel|
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   921
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   922
    data notNil ifTrue:[
1458
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   923
        ^ data
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   924
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   925
    drawableId isNil ifTrue:[
1458
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   926
        fileName notNil ifTrue:[
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   927
            ^ (self on:Screen current) bits
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   928
        ].
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   929
        ^ nil
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   930
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   931
2060
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   932
    spaceBitsPerPixel := depth.
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   933
    (depth > 8) ifTrue:[
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   934
        spaceBitsPerPixel := 16.
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   935
        (depth > 16) ifTrue:[
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   936
            spaceBitsPerPixel := 32.
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   937
            (depth > 32) ifTrue:[
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   938
                spaceBitsPerPixel := depth.
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   939
            ]
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   940
        ]
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   941
    ].
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   942
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
   943
    bytesPerLine := (width * spaceBitsPerPixel + 31) // 32 * 4.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   944
    inData := ByteArray uninitializedNew:(bytesPerLine * height).
1461
6d8b022bfcd8 renamed getBitsFrom to getBitsFromId
Claus Gittinger <cg@exept.de>
parents: 1458
diff changeset
   945
    info := device getBitsFromPixmapId: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
   946
    bytesPerLineIn := (info at:#bytesPerLine).                    "what I got"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   947
    bytesPerLine := (width * depth + 7) // 8.                     "what I want"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   948
    (bytesPerLine ~~ bytesPerLineIn) ifTrue:[
1458
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   949
        "
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   950
         different padding - have to copy over row-wise
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   951
        "
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   952
        tmpData := inData.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   953
        inData := ByteArray uninitializedNew:(bytesPerLine * height).
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   954
        srcIndex := 1.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   955
        dstIndex := 1.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   956
        1 to:height do:[:hi |
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   957
            inData replaceFrom:dstIndex to:(dstIndex + bytesPerLine - 1)
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   958
                          with:tmpData startingAt:srcIndex.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   959
            dstIndex := dstIndex + bytesPerLine.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   960
            srcIndex := srcIndex + bytesPerLineIn
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   961
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   962
    ] ifFalse:[
1458
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   963
        "
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   964
         same padding - copy over all in one chunk
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   965
        "
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   966
        (bytesPerLine * height) ~~ inData size ifTrue:[
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   967
            tmpData := inData.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   968
            inData := ByteArray uninitializedNew:(bytesPerLine * height).
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   969
            inData replaceFrom:1 to:bytesPerLine * height with:tmpData startingAt:1
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   970
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   971
    ].
1645
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   972
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
     have to reverse bytes, if not msbFirst ?
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
   975
    "
915
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   976
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   977
"/    (info at:#byteOrder) ~~ #msbFirst ifTrue:[
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   978
"/        buffer := ByteArray new:bytesPerLine.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   979
"/        dstIndex := 1.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   980
"/        1 to:height do:[:hi |
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   981
"/            buffer replaceFrom:1 to:bytesPerLine with:inData startingAt:dstIndex.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   982
"/            buffer reverse.
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   983
"/            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
   984
"/            dstIndex := dstIndex + bytesPerLine
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   985
"/        ]
1ac3e38e6da5 oops - accessing a forms device bits was wrong for
ca
parents: 910
diff changeset
   986
"/    ].
1645
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   987
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   988
    "
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   989
     have to reverse bits, if not msbFirst ?
67ea694c219d comment
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   990
    "
398
2b35bb58a82b changes for new returned info from getBits
Claus Gittinger <cg@exept.de>
parents: 278
diff changeset
   991
    (info at:#bitOrder) ~~ #msbFirst ifTrue:[
1458
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   992
        buffer := ByteArray new:bytesPerLine.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   993
        dstIndex := 1.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   994
        1 to:height do:[:hi |
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   995
            buffer replaceFrom:1 to:bytesPerLine with:inData startingAt:dstIndex.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   996
            buffer expandPixels:8 width:bytesPerLine height:1 into:buffer
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   997
                                mapping:(ImageReader reverseBits).  "/ translate only
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   998
            inData replaceFrom:dstIndex to:dstIndex+bytesPerLine-1 with:buffer startingAt:1.
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
   999
            dstIndex := dstIndex + bytesPerLine
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
  1000
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1001
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1002
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1003
    ^ inData.
1458
612420702141 splitted getBitsFrom into getBitsFromPixmap
Claus Gittinger <cg@exept.de>
parents: 1452
diff changeset
  1004
2060
effcaa60f42d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1964
diff changeset
  1005
    "Modified: / 19.2.1998 / 14:47:06 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1006
!
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
bits:aByteArray
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1009
    "set the forms bits; 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1010
     for depth-8 forms, 1 pixel/byte is expected;
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1011
     for depth-1 forms, 8 pixels/byte are expected
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1012
     for depth-4 forms, 2 pixels/byte are expected.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1013
     Padding is expected to the next byte-boundary 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1014
     (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
  1015
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1016
    data := aByteArray
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1017
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1018
    "Modified: 23.4.1996 / 10:06:01 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1019
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1020
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1021
bitsPerSample
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1022
    "for compatibility with Image class ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1023
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1024
    ^ Array with:depth
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
colorMap
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1028
    "return the receivers colormap"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1029
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1030
    ^ localColorMap
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1031
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1032
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
  1033
colorMap:anArrayOrColorMap
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1034
    "set the receivers colormap"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1035
1446
3007549e3d5e never convert a colorArray to a colorMap
Claus Gittinger <cg@exept.de>
parents: 1436
diff changeset
  1036
    localColorMap := anArrayOrColorMap
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
  1037
1446
3007549e3d5e never convert a colorArray to a colorMap
Claus Gittinger <cg@exept.de>
parents: 1436
diff changeset
  1038
    "Modified: 7.3.1997 / 21:26:11 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1039
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1040
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1041
depth
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1042
    "return the receivers depth"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1043
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1044
    ^ depth
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1045
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1046
2456
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1047
fileName
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1048
    "return the filename, from which the receiver was created,
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1049
     or nil, if it was not read from a file"
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1050
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1051
    ^ fileName
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1052
!
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1053
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1054
filename
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1055
    "return the filename, from which the receiver was created,
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1056
     or nil, if it was not read from a file"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1057
2456
43f9a6f0c1e5 + #fileName
Claus Gittinger <cg@exept.de>
parents: 2191
diff changeset
  1058
    "/ going to be obsoleted - use #fileName
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1059
    ^ fileName
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1060
!
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
forgetBits
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1063
    "for image, which also keeps the bits - so there is
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1064
     no need to hold them again here"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1065
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1066
    data := nil
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1067
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1068
897
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1069
mask
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1070
    "for compatibility with images; forms have no mask/alpha channel"
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1071
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1072
    ^ nil
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1073
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1074
    "Created: 21.6.1996 / 12:52:42 / cg"
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1075
!
ad8ff0206343 mask access
Claus Gittinger <cg@exept.de>
parents: 889
diff changeset
  1076
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1077
photometric
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1078
    "for compatibility with Image class ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1079
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1080
    depth == 1 ifTrue:[
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1081
	localColorMap isNil ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1082
	    ^ #whiteIs0
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1083
	].
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1084
	((localColorMap at:1) = Color white) ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1085
	    ((localColorMap at:2) = Color black) ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1086
		^ #whiteIs0
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1087
	    ].
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1088
	].
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1089
	((localColorMap at:1) = Color black) ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1090
	    ((localColorMap at:2) = Color white) ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1091
		^ #blackIs0
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1092
	    ].
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1093
	].
278
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
    ^ #palette
872
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
  1096
ae232ece067d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 871
diff changeset
  1097
    "Modified: 17.6.1996 / 11:45:16 / cg"
278
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
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1100
samplesperPixel
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1101
    "for compatibility with Image class ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1102
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1103
    ^ 1
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1104
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1105
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1106
valueAt:aPoint
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1107
    "return the pixel at aPoint; the coordinates start with 0@0
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1108
     in the upper left, increasing to the lower right"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1109
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1110
    ^ self at:aPoint
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1111
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1112
    "Modified: 23.4.1996 / 10:06:55 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1113
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1114
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1115
valueAt:aPoint put:value
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1116
    "set the pixel at aPoint; the coordinates start with 0@0
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1117
     in the upper left, increasing to the lower right."
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1118
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1119
    ^ self at:aPoint put:value
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1120
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1121
    "
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1122
     |f|
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1123
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1124
     f := Form width:10 height:10 depth:1.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1125
     f clear.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1126
     1 to:10 do:[:i |
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1127
	f valueAt:(i @ i) put:1
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1128
     ].
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1129
     f inspect
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1130
    "
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1131
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1132
    "Modified: 23.4.1996 / 10:12:48 / cg"
278
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
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1135
!Form methodsFor:'binary storage'!
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
readBinaryContentsFrom: stream manager: manager
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1138
    "tell the newly restored Form about restoration"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1139
2850
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1140
    width := manager nextObject.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1141
    height := manager nextObject.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1142
    depth := manager nextObject.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1143
    offset := manager nextObject.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1144
    data := manager nextObject.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1145
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1146
"/    super readBinaryContentsFrom: stream manager: manager.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1147
"/    device := nil. "/ Screen current.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1148
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1149
    fileName := nil.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1150
    self restored.
2850
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1151
"/    self recreate.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1152
"/    Lobby register:self.
278
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
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1155
     |f|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1156
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1157
     f := Form fromFile:'bitmaps/SBrowser.xbm'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1158
     f storeBinaryOn:'foo.bos'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1159
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1160
     (Form readBinaryFrom:'foo.bos') inspect
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1161
    "
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
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1164
storeBinaryDefinitionOn: stream manager: manager
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1165
    "store a binary representation of the receiver on stream.
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1166
     This is an internal interface for binary storage mechanism.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1167
     Redefined to store the actual bits, even if I have been loaded 
2850
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1168
     from a file, and to ommit all device related stuff."
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1169
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1170
    |bits savedData savedDevice|
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1171
2850
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1172
    manager putIdOfClass:(self class) on:stream.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1173
    manager putIdOf:width on:stream.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1174
    manager putIdOf:height on:stream.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1175
    manager putIdOf:depth on:stream.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1176
    manager putIdOf:offset on:stream.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1177
    (bits := data) isNil ifTrue:[
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1178
        bits := self bits.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1179
    ].
2850
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1180
    manager putIdOf:bits on:stream.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1181
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1182
"/    savedDevice := device.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1183
"/    (savedData := data) isNil ifTrue:[
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1184
"/        data := self bits.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1185
"/    ].
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1186
"/    device := nil.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1187
"/    super storeBinaryDefinitionOn:stream manager:manager.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1188
"/    data := savedData.
cac9758df2ca crippled binaryStorage, to avoid desaster
Claus Gittinger <cg@exept.de>
parents: 2849
diff changeset
  1189
"/    device := savedDevice.
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1190
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1191
    "Modified: 23.4.1996 / 09:30:47 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1192
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1193
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1194
!Form methodsFor:'converting'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1195
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1196
asForm
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1197
    "convert & return the receiver into a Form instance - nothing to be done here"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1198
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1199
    ^ self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1200
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1201
    "Modified: 23.4.1996 / 10:14:11 / cg"
278
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
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1204
asImage
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1205
    "convert & return the receiver into an Image instance"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1206
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1207
    ^ Image fromForm:self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1208
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1209
    "Modified: 23.4.1996 / 10:13:56 / cg"
278
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
!Form methodsFor:'copying'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1213
2849
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1214
executor
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1215
    "redefined for faster creation of finalization copies
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1216
     (only device, gcId and drawableId are needed)"
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1217
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1218
    ^ DeviceFormHandle basicNew setDevice:device id:drawableId gcId:gcId.
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1219
!
8d0631de6985 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2827
diff changeset
  1220
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1221
postCopy
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1222
    "redefined to copy the colorMap as well"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1223
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1224
    super postCopy.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1225
    localColorMap := localColorMap copy.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1226
    data := data copy
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1227
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1228
    "Modified: 23.4.1996 / 10:14:46 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1229
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1230
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1231
!Form methodsFor:'editing'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1232
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1233
show
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1234
    "open an imageView on the receiver"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1235
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1236
    ImageView openOnImage:self
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1237
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1238
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1239
     (Form fromFile:'bitmaps/SBrowser.xbm') show
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1240
    "
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1241
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1242
    "Modified: 23.4.1996 / 10:16:12 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1243
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1244
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1245
!Form methodsFor:'getting a device form'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1246
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1247
asFormOn:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1248
    "convert & return the receiver into a Form instance
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1249
     and associate it to a device (i.e. download its bits).
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1250
     Added for protocol compatibility with Image."
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1251
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1252
    aDevice == device ifTrue:[
1889
8e24afd8174e Send #onDevice instead of obsolete #on:
Stefan Vogel <sv@exept.de>
parents: 1745
diff changeset
  1253
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1254
    ].
1889
8e24afd8174e Send #onDevice instead of obsolete #on:
Stefan Vogel <sv@exept.de>
parents: 1745
diff changeset
  1255
    ^ self onDevice:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1256
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1257
    "Modified: 23.4.1996 / 10:17:26 / cg"
1889
8e24afd8174e Send #onDevice instead of obsolete #on:
Stefan Vogel <sv@exept.de>
parents: 1745
diff changeset
  1258
    "Modified: 26.8.1997 / 10:29:14 / stefan"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1259
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1260
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1261
asMonochromeFormOn:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1262
    "added for protocol compatiblity with Image"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1263
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1264
    aDevice == device ifTrue:[
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1265
        depth == 1 ifTrue:[
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1266
            ^ self
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1267
        ].
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1268
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1269
    (depth == 1) ifTrue:[
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1270
        ^ self onDevice:aDevice
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1271
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1272
    ^ nil
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1273
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1274
    "Modified: / 27.7.1998 / 20:04:37 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1275
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1276
3104
edc88b280153 added #exactOn: - for Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3068
diff changeset
  1277
exactOn:aDevice
3106
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1278
    "for compatibility with color protocol - here, the same as #onDevice."
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1279
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1280
    ^ self onDevice:aDevice
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1281
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1282
!
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1283
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1284
exactOrNearestOn:aDevice
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1285
    "for compatibility with color protocol - here, the same as #onDevice."
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1286
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1287
    ^ self onDevice:aDevice
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1288
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1289
!
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1290
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1291
nearestOn:aDevice
d6333a2bd850 more Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3104
diff changeset
  1292
    "for compatibility with color protocol - here, the same as #onDevice."
3104
edc88b280153 added #exactOn: - for Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3068
diff changeset
  1293
edc88b280153 added #exactOn: - for Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3068
diff changeset
  1294
    ^ self onDevice:aDevice
edc88b280153 added #exactOn: - for Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3068
diff changeset
  1295
edc88b280153 added #exactOn: - for Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3068
diff changeset
  1296
!
edc88b280153 added #exactOn: - for Color-protocol compatibility
Claus Gittinger <cg@exept.de>
parents: 3068
diff changeset
  1297
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1298
on:aDevice
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1299
    "associate the receiver to a device (i.e. download its bits);
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1300
     return a deviceForm (possibly different from the receiver)."
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1301
1741
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1302
    "/ send out a warning: #on: is typically used to create views
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1303
    "/ operating on a model.
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1304
    "/ Please use #onDevice: to avoid confusion.
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1305
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1306
    self obsoleteMethodWarning:'use #onDevice:'.
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1307
    ^ self onDevice:aDevice
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1308
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1309
    "Modified: 5.6.1997 / 21:05:34 / cg"
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1310
!
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1311
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1312
onDevice:aDevice
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1313
    "associate the receiver to a device (i.e. download its bits);
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1314
     return a deviceForm (possibly different from the receiver)."
b84a2f4317e9 warn #on: vs. #onDevice:
Claus Gittinger <cg@exept.de>
parents: 1645
diff changeset
  1315
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1316
    aDevice == device ifTrue:[
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
  1317
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1318
    ].
2980
409e9547a45c ignore nil device in #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2964
diff changeset
  1319
    aDevice isNil ifTrue:[^ self].
409e9547a45c ignore nil device in #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2964
diff changeset
  1320
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1321
    "create a new form ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1322
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1323
    data notNil ifTrue:[
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1324
        "/ 'Form [info]: create from data' printCR.
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
  1325
        ^ self class width:width height:height fromArray:data on:aDevice
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1326
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1327
    fileName notNil ifTrue:[
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1328
        "/ 'Form [info]: create from file' printCR.
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
  1329
        ^ self class fromFile:fileName on:aDevice
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1330
    ].
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1331
    'Form [warning]: no bit data in #onDevice: - returning a black form.' infoPrintCR.
1436
c64b7abfc5fe checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1325
diff changeset
  1332
    ^ (self class width:width height:height on:aDevice) clear
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1333
2191
7be9c2c6c66f use #onDevice: in #asMono
Claus Gittinger <cg@exept.de>
parents: 2074
diff changeset
  1334
    "Modified: / 27.7.1998 / 20:05:20 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1335
! !
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1336
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1337
!Form methodsFor:'image manipulations'!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1338
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1339
darkened
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1340
    "return a darkened version of the receiver.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1341
     Added for protocol compatibility with Color and Image.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1342
     Here, the receiver is returned as a kludge 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1343
     - actually should return a darkened image (or Color black ?) .."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1344
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1345
    ^ self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1346
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1347
    "Modified: 23.4.1996 / 10:19:52 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1348
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1349
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1350
flipHorizontal
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1351
    "return a new form flipped horizontally"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1352
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1353
    |dstY newForm nRows "{ Class: SmallInteger }" |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1354
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1355
    newForm := (self class on:device)
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1356
                                width:width
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1357
                                height:height
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1358
                                depth:depth.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1359
    "expand rows"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1360
    dstY := height - 1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1361
    nRows := dstY // 2.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1362
    0 to:nRows do:[:srcY |
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1363
        newForm copyFrom:self
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1364
                       x:0 y:srcY
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1365
                     toX:0 y:dstY
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1366
                   width:width height:1.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1367
        dstY := dstY - 1
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1368
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1369
    newForm colorMap:localColorMap.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1370
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1371
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1372
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1373
flipVertical
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1374
    "return a new form flipped vertically"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1375
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1376
    |dstX newForm nCols "{ Class: SmallInteger }" |
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1377
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1378
    newForm := (self class on:device)
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1379
                                width:width
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1380
                                height:height
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1381
                                depth:depth.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1382
    "expand cols"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1383
    dstX := width - 1.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1384
    nCols := dstX // 2.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1385
    0 to:nCols do:[:srcX |
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1386
        newForm copyFrom:self
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1387
                       x:srcX y:0
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1388
                     toX:dstX y:0
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1389
                   width:1 height:height.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1390
        dstX := dstX - 1
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1391
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1392
    newForm colorMap:localColorMap.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1393
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1394
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1395
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1396
hardMagnifiedBy:extent
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1397
    "return a new form magnified by extent, aPoint.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1398
     This method handles non-integral factors."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1399
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1400
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1401
     since Form will be replaced by Image in the long run,
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1402
     and this operation is slow anyway, use the implementation
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1403
     in Image for this."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1404
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1405
    ^ ((Image fromForm:self) magnifiedBy:extent) asFormOn:device.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1406
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
     (Form fromFile:'OutputOn.64') magnifiedBy:0.5@0.5
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1409
     (Form fromFile:'OutputOn.64') magnifiedBy:1.5@1.5
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1410
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1411
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1412
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1413
lightened
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1414
    "return a lightened version of the receiver.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1415
     Added for protocol compatibility with Color and Image.
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1416
     Here, the receiver is returned as a kludge 
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1417
     - actually should return a lightened image (or Color white ?) .."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1418
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1419
    ^ self
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1420
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1421
    "Modified: 23.4.1996 / 10:20:14 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1422
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1423
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1424
magnifiedBy:extent
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1425
    "return a new form magnified by extent, aPoint.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1426
     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
  1427
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1428
    |mX mY dstX dstY newForm ext 
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1429
     factor "{ Class: SmallInteger }"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1430
     n      "{ Class: SmallInteger }" |
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
    ext := extent asPoint.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1433
    mX := ext x.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1434
    mY := ext y.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1435
    ((mX = 1) and:[mY = 1]) ifTrue:[^ self].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1436
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1437
    ((mX isMemberOf:SmallInteger) and:[mY isMemberOf:SmallInteger]) ifFalse:[
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1438
        ^ self hardMagnifiedBy:ext
278
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
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1441
    newForm := (self class on:device)
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1442
                                width:(width * mX)
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1443
                                height:(height * mY)
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1444
                                depth:depth.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1445
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1446
    "expand rows"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1447
    (mY > 1) ifTrue:[
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1448
        dstY := 0.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1449
        n := height.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1450
        factor := mY.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1451
        0 to:(n - 1) do:[:srcY |
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1452
            1 to:factor do:[:i |
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1453
                newForm copyFrom:self
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1454
                               x:0 y:srcY
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1455
                             toX:0 y:dstY
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1456
                           width:width height:1.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1457
                dstY := dstY + 1
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1458
            ]
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1459
        ]
278
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
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1462
    "expand cols"
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1463
    (mX > 1) ifTrue:[
2827
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1464
        n := width.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1465
        factor := mX.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1466
        dstX := (n * factor) - 1.
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1467
        (n - 1) to:0 by:-1 do:[:srcX |
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1468
            1 to:factor do:[:i |
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1469
                newForm copyFrom:newForm
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1470
                               x:srcX y:0
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1471
                             toX:dstX y:0
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1472
                           width:1 height:(height * mY).
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1473
                dstX := dstX - 1
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1474
            ]
4f30d3aa96e5 #on: -> #onDevice:
Claus Gittinger <cg@exept.de>
parents: 2823
diff changeset
  1475
        ]
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1476
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1477
    newForm colorMap:localColorMap.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1478
    ^ newForm
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1479
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1480
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1481
     (ArrowButton upArrowButtonForm:#iris on:Display) magnifiedBy:(2 @ 2)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1482
     (Form fromFile:'bitmaps/SBrowser.xbm') magnifiedBy:(2 @ 2)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1483
     (Form fromFile:'bitmaps/SBrowser.xbm') magnifiedBy:(0.4 @ 0.4)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1484
    "
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1485
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1486
569
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1487
magnifiedTo:anExtent 
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1488
    "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
  1489
     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
  1490
     See also #magnifiedPreservingRatioTo: and #magnifiedBy:"
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1491
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1492
    ^ self magnifiedBy:(anExtent / self extent)
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1493
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1494
    "Created: 18.4.1996 / 16:17:52 / cg"
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1495
!
7dee80bce37b added #magnifiedTo: (protocol compatibility with Image)
Claus Gittinger <cg@exept.de>
parents: 425
diff changeset
  1496
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1497
magnifyBy:scale
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1498
    "obsolete: has been renamed to magnifiedBy: for ST-80 compatibility
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1499
     and name consistency ..."
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1500
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1501
    self obsoleteMethodWarning.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1502
    ^ self magnifiedBy:scale
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
!Form methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1506
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1507
createGC
1452
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1508
    "physically create a device GC.
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1509
     Since we do not need a gc-object for the drawable until something is
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1510
     really drawn, none is created up to the first draw.
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1511
     This method is sent, when the first drawing happens.
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1512
     Redefined here to create a bitmap GC (some devices (i.e. windows) require
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1513
     different GC's for different canvases."
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1514
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1515
    gcId := device gcForBitmap:drawableId.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1516
    Lobby registerChange:self.
1452
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1517
c76c6637903c commentary
Claus Gittinger <cg@exept.de>
parents: 1446
diff changeset
  1518
    "Modified: 19.3.1997 / 11:08:49 / cg"
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1519
!
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1520
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1521
initGC
48194c26a46c Initial revision
claus
parents:
diff changeset
  1522
    "stop server from sending exposure events for Forms -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1523
     (will fill up stream-queue on some stupid (i.e. sco) systems"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1524
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1525
    "/ depth-1 forms draw differently ...
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1526
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1527
    depth == 1 ifTrue:[
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1528
	foreground isNil ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1529
	    foreground := paint := Color colorId:1.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1530
	].
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1531
	background isNil ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1532
	    background := bgPaint := Color colorId:0
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1533
	]
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1534
    ].
126
4fc31fd808c8 *** empty log message ***
claus
parents: 118
diff changeset
  1535
    super initGC.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1536
    self setGraphicsExposures:false
836
d6eb406b1c04 dither bitmaps moved to Color
Claus Gittinger <cg@exept.de>
parents: 789
diff changeset
  1537
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1538
    "Modified: 17.7.1996 / 13:21:24 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1539
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1540
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1541
initialize
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1542
    foreground := paint := Color colorId:1.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1543
    background := bgPaint := Color colorId:0.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1544
3068
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1545
    "/ must allow for device-less forms to be created
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1546
    true "device isNil" ifTrue:[
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1547
        realized := false.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1548
        width := 0.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1549
        height := 0.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1550
        function := #copy.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1551
        lineWidth := 1.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1552
        lineStyle := #solid.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1553
        joinStyle := #miter.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1554
        capStyle := #butt.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1555
        font := DefaultFont.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1556
    ] ifFalse:[
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1557
        super initialize.
7f4b0dd1f738 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3067
diff changeset
  1558
    ].
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1559
    depth := 1.
836
d6eb406b1c04 dither bitmaps moved to Color
Claus Gittinger <cg@exept.de>
parents: 789
diff changeset
  1560
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1561
"/    foreground isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1562
"/        foreground := Color colorId:1.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1563
"/    ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1564
"/    paint isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1565
"/        paint := foreground.
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1566
"/    ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1567
"/    background isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1568
"/        background := Color colorId:0
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1569
"/    ].
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1570
"/    bgPaint isNil ifTrue:[
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1571
"/        bgPaint := background
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1572
"/    ]
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1573
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1574
    "Modified: 17.7.1996 / 13:02:01 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1575
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1576
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1577
recreate
48194c26a46c Initial revision
claus
parents:
diff changeset
  1578
    "reconstruct the form after a snapin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1579
2473
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1580
    device isNil ifTrue:[^ self].
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1581
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1582
    data notNil ifTrue:[
2473
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1583
        "
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1584
         create one from data
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1585
        "
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1586
        (depth == 1 or:[depth == device depth]) ifTrue:[
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1587
            drawableId := device createBitmapFromArray:data width:width height:height.
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1588
            Lobby registerChange:self. 
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1589
            drawableId notNil ifTrue:[
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1590
                ^ self
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1591
            ]
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1592
        ].
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1593
        'FORM: cannot recreate form' errorPrintCR.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1594
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1595
    fileName notNil ifTrue:[
2473
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1596
        "
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1597
         create one from a file (mhmh - this seems X-specific and will vanish)
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1598
        "
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1599
        self readFromFile:fileName.
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1600
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1601
"/        drawableId := device createBitmapFromFile:fileName for:self.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1602
"/        Lobby registerChange:self.
2473
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1603
        drawableId notNil ifTrue:[
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1604
            ^ self
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1605
        ].
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1606
        'FORM: cannot recreate file form: ' errorPrint. fileName errorPrintCR.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1607
    ].
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1608
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1609
    ^ self.
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1610
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1611
    "
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1612
     create an empty one
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1613
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1614
    depth == 1 ifTrue:[
2473
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1615
        drawableId := device createBitmapWidth:width height:height
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1616
    ] ifFalse:[
2473
2d4b51e6eb48 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2456
diff changeset
  1617
        drawableId := device createPixmapWidth:width height:height depth:device depth
118
25e775072a89 *** empty log message ***
claus
parents: 115
diff changeset
  1618
    ].
162
claus
parents: 156
diff changeset
  1619
    Lobby registerChange:self
871
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1620
c078c33c51ac recreate was somehow corrupted ?!
Claus Gittinger <cg@exept.de>
parents: 870
diff changeset
  1621
    "Modified: 15.6.1996 / 16:18:12 / cg"
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1622
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1623
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1624
!Form methodsFor:'inspecting'!
127
98b0725782bd *** empty log message ***
claus
parents: 126
diff changeset
  1625
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1626
inspectorClass
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1627
    "redefined to launch an ImageInspector
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1628
     (instead of the default InspectorView)."
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1629
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1630
    ^ ImageInspectorView
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1631
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  1632
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1633
!Form methodsFor:'printing & storing'!
107
ef48048a8b34 *** empty log message ***
claus
parents: 99
diff changeset
  1634
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1635
storeOn:aStream
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1636
    "append an ascii representation of the receiver to aStream,
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1637
     from which a copy of the receiver can be reconstructed"
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1638
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1639
    aStream nextPutAll:'(Form width:'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1640
    width storeOn:aStream.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1641
    aStream nextPutAll:' height:'.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1642
    height storeOn:aStream.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1643
    aStream nextPutAll:' fromArray:('.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1644
    self bits storeOn:aStream.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1645
    aStream nextPutAll:'))'
588
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1646
8aee1c8800c9 commentary
Claus Gittinger <cg@exept.de>
parents: 569
diff changeset
  1647
    "Modified: 23.4.1996 / 10:21:10 / cg"
107
ef48048a8b34 *** empty log message ***
claus
parents: 99
diff changeset
  1648
! !
ef48048a8b34 *** empty log message ***
claus
parents: 99
diff changeset
  1649
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1650
!Form methodsFor:'private'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1651
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
  1652
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
  1653
    "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
  1654
     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
  1655
     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
  1656
     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
  1657
     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
  1658
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
  1659
    data isNil ifTrue:[
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1660
	data := self bits.
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1661
	data notNil ifTrue:[
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1662
	    fileName := nil
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1663
	]
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
  1664
    ]
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
  1665
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
  1666
    "
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
  1667
     Form allInstances:[:f |
1138
4a2b3b407cae need separate createGC method for bitmaps (for WIN)
Claus Gittinger <cg@exept.de>
parents: 1058
diff changeset
  1668
	f beImmediateForm
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
  1669
     ]
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
  1670
    "
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
  1671
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
  1672
    "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
  1673
!
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
  1674
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1675
flushDeviceHandles
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1676
    "flush device handles (sent after a restart)"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1677
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1678
    drawableId := nil.
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1679
    gcId := nil.
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1680
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1681
    "Created: 15.6.1996 / 15:44:28 / cg"
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1682
!
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1683
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1684
getBits
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1685
    "if the receiver was not created from a file, or
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1686
     an array (i.e. it was drawn), read the pixels from the
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1687
     device into a local data array. This has to be done before
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1688
     an image is saved, or the receiver is storedBinary, since
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1689
     the information present in the device is lost after restart/reload"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1690
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1691
    (data isNil and:[fileName isNil]) ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 71
diff changeset
  1692
	data := self bits
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1693
    ]
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1694
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1695
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
  1696
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
  1697
    "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
  1698
     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
  1699
     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
  1700
     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
  1701
     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
  1702
     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
  1703
     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
  1704
     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
  1705
     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
  1706
     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
  1707
     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
  1708
     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
  1709
     "
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1710
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1711
    |pathName|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1712
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1713
    "/ this method is a historic leftover; it uses
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1714
    "/ the X-libs bitmap file reading function, which is not
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1715
    "/ available with other windowing systems ...
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1716
    self obsoleteMethodWarning:'use Image fromFile:'.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1717
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
  1718
    pathName := self class findBitmapFile:fn.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1719
    pathName notNil ifTrue:[
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1720
        drawableId := device createBitmapFromFile:pathName for:self.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1721
        drawableId isNil ifTrue:[^ 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
  1722
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
  1723
"/        fileName := pathName. "/ keep the actual name (wrong)
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1724
        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
  1725
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1726
        offset := 0@0.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1727
        realized := true.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1728
        BlackAndWhiteColorMap isNil ifTrue:[
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1729
            BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1730
        ].
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1731
        localColorMap := BlackAndWhiteColorMap.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1732
        Lobby registerChange:self.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1733
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1734
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1735
    ^ 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
  1736
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
  1737
    "Modified: 7.2.1996 / 16:04:25 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1738
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1739
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1740
readFromFile:filename resolution:dpi
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1741
    "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
  1742
     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
  1743
     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
  1744
     after an image reload."
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1745
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1746
    |dpiH mag dev|
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1747
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1748
    (self readFromFile:filename) isNil ifTrue:[^ nil].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1749
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1750
    "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
  1751
    dev := device.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1752
    dev isNil ifTrue:[
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1753
        "should not happen ..."
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1754
        dev := Screen current
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1755
    ].
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1756
    dpiH := dev isNil ifTrue:[90] ifFalse:[dev horizontalPixelPerInch].
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1757
    ((dpi >= (dpiH * 0.75)) and:[dpi <= (dpiH * 1.5)]) ifTrue:[^ self].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1758
    mag := (dpiH / dpi) rounded.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1759
    mag == 0 ifTrue:[
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1760
        ^ self
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1761
    ].
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1762
    ^ self magnifiedBy:(mag @ mag)
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1763
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1764
    "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
  1765
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
  1766
    "Modified: 7.2.1996 / 16:03:45 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1767
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1768
1058
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1769
release
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1770
    "flush device data"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1771
425
7e1df86e2517 flush device ref when restored
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
  1772
    device := nil.
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1773
    drawableId := nil.
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1774
    gcId := nil.
1745
7333e0ddc087 oops - release must send a super release also
Claus Gittinger <cg@exept.de>
parents: 1741
diff changeset
  1775
    super release.
870
2b7db80e7ad1 oops - restart mechanism got corrupted
Claus Gittinger <cg@exept.de>
parents: 836
diff changeset
  1776
1058
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1777
    "Created: 16.9.1996 / 21:08:50 / cg"
1745
7333e0ddc087 oops - release must send a super release also
Claus Gittinger <cg@exept.de>
parents: 1741
diff changeset
  1778
    "Modified: 11.6.1997 / 13:19:05 / cg"
1058
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1779
!
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1780
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1781
restored
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1782
    "flush device data, when restored (sent after a binaryLoad)"
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1783
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1784
    self release
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1785
103860173cb2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 951
diff changeset
  1786
    "Modified: 16.9.1996 / 21:08:57 / cg"
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1787
!
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  1788
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1789
width:w height:h
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1790
    "actual create of a monochrome form"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1791
48194c26a46c Initial revision
claus
parents:
diff changeset
  1792
    ((w == 0) or:[h == 0]) ifTrue:[
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1793
        self error:'invalid form extent'.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1794
        ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1795
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1796
    width := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1797
    height := h.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1798
    depth := 1.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1799
    offset := 0@0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1800
    BlackAndWhiteColorMap isNil ifTrue:[
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1801
        BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1802
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1803
    localColorMap := BlackAndWhiteColorMap.
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1804
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1805
    device notNil ifTrue:[
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1806
        drawableId := device createBitmapWidth:w height:h.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1807
"/        drawableId isNil ifTrue:[^ nil].
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1808
        realized := true.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1809
        Lobby registerChange:self.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1810
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1811
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1812
48194c26a46c Initial revision
claus
parents:
diff changeset
  1813
width:w height:h depth:d
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1814
    "actual create of an arbitrary deep form (but, must be supported by device)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1815
48194c26a46c Initial revision
claus
parents:
diff changeset
  1816
    width := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1817
    height := h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1818
    offset := 0@0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1819
    depth := d.
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1820
    device notNil ifTrue:[
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1821
        drawableId := device createPixmapWidth:w height:h depth:d.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1822
"/        drawableId isNil ifTrue:[^ nil].
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1823
        realized := true.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1824
        Lobby registerChange:self.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1825
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1826
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1827
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1828
width:wIn height:hIn fromArray:anArray
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1829
    "actual create of a monochrome form from array.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1830
     This method is somewhat more complicated as it should be due to 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1831
     supporting both byte-wise (ST/X-type) and short-word-wise (ST-80-type)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1832
     Arrays; in the later case, the shorts are first converted to bytes in
48194c26a46c Initial revision
claus
parents:
diff changeset
  1833
     a ByteArray, then passed to the device."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1834
134
claus
parents: 133
diff changeset
  1835
    |bytes bits 
claus
parents: 133
diff changeset
  1836
     srcPerRow "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1837
     dstPerRow "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1838
     srcStart  "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1839
     srcIndex  "{ Class: SmallInteger }"
claus
parents: 133
diff changeset
  1840
     dstIndex  "{ Class: SmallInteger }"
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1841
     hi        "{ Class: SmallInteger }" 
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1842
     w         "{ Class: SmallInteger }" 
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1843
     h         "{ Class: SmallInteger }"
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1844
     sz        "{ Class: SmallInteger }" |
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1845
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1846
    w := wIn.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1847
    h := hIn.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1848
    bytes := anArray.
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1849
    sz := anArray size.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1850
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1851
    sz ~~ (((w + 7) // 8) * h) ifTrue:[
3020
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1852
        "/ not bytes ...
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1853
        sz == (((w + 15) // 16) * h) ifTrue:[
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1854
            "I want the bytes but got shorts (ST-80)"
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1855
            bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h).
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1856
            srcPerRow := (w + 15) // 16.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1857
            dstPerRow := (w + 7) // 8.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1858
            srcStart := 1.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1859
            dstIndex := 1.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1860
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1861
            1 to:h do:[:hi |
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1862
                srcIndex := srcStart.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1863
                bits := anArray at:srcIndex.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1864
                1 to:dstPerRow do:[:di |
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1865
                    di odd ifTrue:[
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1866
                        bits := anArray at:srcIndex.
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1867
                        bytes at:dstIndex put:(bits bitShift:-8)
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1868
                    ] ifFalse:[
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1869
                        bytes at:dstIndex put:(bits bitAnd:16rFF).
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1870
                        srcIndex := srcIndex + 1
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1871
                    ].
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1872
                    dstIndex := dstIndex + 1
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1873
                ].
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1874
                srcStart := srcStart + srcPerRow
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1875
            ]
3020
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1876
        ] ifFalse:[
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1877
            sz == (((w + 31) // 32) * h) ifTrue:[
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1878
                "I want the bytes but got longs (Squeak)"
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1879
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1880
                bytes := ByteArray uninitializedNew:(((w + 7) // 8) * h).
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1881
                srcPerRow := (w + 31) // 32.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1882
                dstPerRow := (w + 7) // 8.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1883
                srcStart := 1.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1884
                dstIndex := 1.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1885
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1886
                1 to:h do:[:hi |
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1887
                    |ss|
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1888
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1889
                    srcIndex := srcStart.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1890
                    bits := anArray at:srcIndex.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1891
                    ss := 0.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1892
                    1 to:dstPerRow do:[:di |
3025
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
  1893
                        ss == 0 ifTrue:[
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
  1894
                            bits := anArray at:srcIndex.
11d768e415c2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 3020
diff changeset
  1895
                        ].
3020
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1896
                        bytes at:dstIndex put:((bits bitShift:-24) bitAnd:16rFF).
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1897
                        bits := bits bitShift:8.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1898
                        ss := ss + 1.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1899
                        ss == 4 ifTrue:[
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1900
                            srcIndex := srcIndex + 1.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1901
                            ss := 0.
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1902
                        ].
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1903
                        dstIndex := dstIndex + 1
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1904
                    ].
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1905
                    srcStart := srcStart + srcPerRow
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1906
                ]
e043c3d30613 more Squeak compatibility stuff
ps
parents: 2980
diff changeset
  1907
            ]
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1908
        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1909
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1910
    width := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1911
    height := h.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1912
    depth := 1.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1913
    offset := 0@0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1914
    data := bytes.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1915
    BlackAndWhiteColorMap isNil ifTrue:[
2773
8aefa2576a50 a few more smallInteger type hints
Claus Gittinger <cg@exept.de>
parents: 2473
diff changeset
  1916
        BlackAndWhiteColorMap := Array with:(Color white) with:(Color black)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1917
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1918
    localColorMap := BlackAndWhiteColorMap.
3067
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1919
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1920
    device notNil ifTrue:[
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1921
        drawableId := device createBitmapFromArray:bytes width:w height:h.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1922
"/        drawableId isNil ifTrue:[^ nil].
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1923
        realized := true.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1924
        Lobby registerChange:self.
908e910e6c94 allow forms to be created without a device.
Claus Gittinger <cg@exept.de>
parents: 3025
diff changeset
  1925
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1926
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1927
48194c26a46c Initial revision
claus
parents:
diff changeset
  1928
width:w height:h offset:offs fromArray:anArray
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1929
    "actual create of a monochrome form from array"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1930
48194c26a46c Initial revision
claus
parents:
diff changeset
  1931
    self width:w height:h fromArray:anArray.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1932
    offset := offs
48194c26a46c Initial revision
claus
parents:
diff changeset
  1933
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1934
99
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1935
!Form methodsFor:'queries '!
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1936
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1937
bounds
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1938
    "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
  1939
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1940
    ^ 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
  1941
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1942
    "Modified: 13.5.1996 / 10:26:13 / cg"
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1943
!
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1944
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1945
colorFromValue:pixel
1200
b77327efe724 comment
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
  1946
    "given a pixelValue, return the corresponding color.
b77327efe724 comment
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
  1947
     For compatibility with Images"
b77327efe724 comment
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
  1948
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1949
    localColorMap notNil ifTrue:[
1200
b77327efe724 comment
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
  1950
        ^ localColorMap at:(pixel + 1)
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1951
    ].
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1952
    depth == 1 ifTrue:[
1200
b77327efe724 comment
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
  1953
        pixel == 0 ifTrue:[^ White].
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1954
    ].
951
ebedf8da0e89 initGC stuff fixed
Claus Gittinger <cg@exept.de>
parents: 935
diff changeset
  1955
    ^ Black
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1956
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1957
    "Created: 28.6.1996 / 16:10:13 / cg"
1200
b77327efe724 comment
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
  1958
    "Modified: 13.1.1997 / 23:06:25 / cg"
910
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1959
!
6a19a80f66b4 added colorFromValue: for Image compatibility
Claus Gittinger <cg@exept.de>
parents: 897
diff changeset
  1960
925
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1961
hasBits
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1962
    "return true, if the receiver has its pixel data available.
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1963
     For forms, which were created from data, this is always true.
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1964
     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
  1965
     device, this is always false."
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1966
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1967
    ^ data notNil
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1968
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1969
    "Created: 5.7.1996 / 16:21:20 / cg"
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1970
!
1467e7850045 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 915
diff changeset
  1971
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1972
heightOn:aGC
674
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1973
    "return my height, if displayed on aGC;
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1974
     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
  1975
     return the pixel-height"
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1976
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  1977
    ^ height
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1978
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1979
    "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
  1980
    "Modified: 13.5.1996 / 10:26:09 / cg"
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1981
!
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1982
99
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1983
isForm
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1984
    "return true, if the receiver is some kind of form;
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1985
     true is returned here - the method is redefined from Object."
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1986
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1987
    ^ true
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1988
!
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1989
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1990
isImageOrForm
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1991
    "return true, if the receiver is some kind of image or form;
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1992
     true is returned here - the method is redefined from Object."
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1993
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  1994
    ^ true
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1995
!
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1996
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  1997
widthOn:aGC
674
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1998
    "return my width, if displayed on aGC;
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  1999
     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
  2000
     return the pixel-width"
e0f6bd36a99d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 673
diff changeset
  2001
680
a905d02dcb82 added #bounds (for VisualComponent protocol compatibility)
Claus Gittinger <cg@exept.de>
parents: 674
diff changeset
  2002
    ^ width
673
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  2003
c755f681e169 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 672
diff changeset
  2004
    "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
  2005
    "Modified: 13.5.1996 / 10:26:05 / cg"
99
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  2006
! !
c40b8a508283 *** empty log message ***
claus
parents: 98
diff changeset
  2007
1907
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2008
!Form::DeviceFormHandle class methodsFor:'documentation'!
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2009
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2010
documentation
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2011
"
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2012
    This is used as a finalization handle for forms - in previous systems,
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2013
    a shallowCopy of a form was responsible to destroy the underlying
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2014
    devices bitmap. To make the memory requirements smaller and to speed up
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2015
    bitmap creation a bit, this lightweight class is used now, which only
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2016
    keeps the device handle for finalization.
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2017
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2018
    [see also:]
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2019
        Form
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2020
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2021
    [author:]
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2022
        Claus Gittinger
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2023
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2024
"
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2025
! !
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2026
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2027
!Form::DeviceFormHandle methodsFor:'finalization'!
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2028
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2029
disposed
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2030
    "the Form for which I am a handle has been collected - tell it to the x-server"
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2031
2074
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2032
    |id|
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2033
1907
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2034
    drawableId notNil ifTrue:[
2074
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2035
	(id := gcId) notNil ifTrue:[
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2036
	    gcId := nil.
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2037
	    device destroyGC:id.
1907
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2038
	].
2074
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2039
	id := drawableId.
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2040
	drawableId := nil.
6a63604051a2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2060
diff changeset
  2041
	device destroyPixmap:id.
1907
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2042
    ]
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2043
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2044
    "Created: 25.9.1997 / 10:03:05 / stefan"
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2045
! !
61fdff318175 Make Device*Handles (used for finalization) private in their resp. classes.
Stefan Vogel <sv@exept.de>
parents: 1889
diff changeset
  2046
1142
2a83bf7d5627 Form>>readFrom: are going to be obsoleted.
Claus Gittinger <cg@exept.de>
parents: 1138
diff changeset
  2047
!Form class methodsFor:'documentation'!
134
claus
parents: 133
diff changeset
  2048
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2049
version
3135
f9304f22f07b handle the case, where not Screen is available
Claus Gittinger <cg@exept.de>
parents: 3106
diff changeset
  2050
    ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.108 2000-01-12 15:18:15 cg Exp $'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2051
! !
278
15e2959e1e58 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  2052
Form initialize!