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