DeviceGraphicsContext.st
author Claus Gittinger <cg@exept.de>
Wed, 17 Jul 1996 14:18:28 +0200
changeset 950 d4d907fc7d78
parent 927 c4bc2a7ff733
child 975 68f73e1ad6c9
permissions -rw-r--r--
checkin from browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1992 by Claus Gittinger
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	      All Rights Reserved
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
GraphicsContext subclass:#DeviceGraphicsContext
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	instanceVariableNames:'drawableId gcId deviceFont foreground background'
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	classVariableNames:'CachedScaledForms CachedScales Lobby'
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	poolDictionaries:''
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	category:'Graphics-Support'
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
    20
!DeviceGraphicsContext  class methodsFor:'documentation'!
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
copyright
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
 COPYRIGHT (c) 1992 by Claus Gittinger
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
	      All Rights Reserved
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
 This software is furnished under a license and may be used
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
 only in accordance with the terms of that license and with the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 be provided or otherwise made available to, or used by, any
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 other person.  No title to or ownership of the software is
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 hereby transferred.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
documentation
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
    I provide the common protocol for a graphicsContext which is associated with a particular
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
    device (i.e. Bitmaps, Pixmaps, RootWindow and Windows in Xs world, but also postscript 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    printer pages or fax pages).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
    My instance variables are mainly caching device-related stuff (such as font- and color-Ids)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    to avoid needless message traffic. This class is abstract, no direct instances of it
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    exist in the system.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    All real work is done by my device, which is accessed via the device instance variable.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    Most drawing requests are simply forwarded to it, others are simulated by using more basic 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    drawing functions (see GraphicsContext drawing vs. basic drawing category).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    The added variables foreground/background are the drawing colors actually 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    used; these are the real (i.e. non dithered) colors supported by the device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    Direct access to fg/bg is discouraged, since in the future, these may be 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    totally replaced by paint/bgPaint 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    (there are some operations and special cases, for which a direct access to 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
     fg/bg makes sense)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
    [Instance variables:]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
        drawableId      <SmallInteger>  my drawableId on the device (a device handle)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
        gcId            <SmallInteger>  my gc's ID on the device (a device handle)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
        deviceFont      <Font>          the actual font, currently set in the device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
        foreground      <Color>         the device foreground color used for drawing
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
        background      <Color>         the device background color used for drawing
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
    [see also:]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
        DeviceWorkstation
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
        Color Font Cursor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
    [author:]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
        Claus Gittinger
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
    78
!DeviceGraphicsContext  class methodsFor:'initialization'!
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
initialize
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
    Lobby isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
	Lobby := Registry new.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
    86
!DeviceGraphicsContext  class methodsFor:'instance creation'!
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
new
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
    "create a new drawable - take the current display as
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
     its device (for now, this may be changed until the view is
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
     physically created)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    'Warning: DeviceGraphicsContext (' print. self name print. ') should not be created with new' printNL.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
    ^ self onDevice:Screen current "Display"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
on:aDevice
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    "create a new drawable on aDevice"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    ^ self onDevice:aDevice
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
onDevice:aDevice
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    "create a new drawable on aDevice"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    |newDrawable|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    newDrawable := self basicNew.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
     set display before its initialized 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
     - so it can do something useful (i.e. get font sizes etc.) in its
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
     intitialize method(s)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
    newDrawable device:aDevice.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
    newDrawable initialize.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
    Lobby register:newDrawable.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
    ^ newDrawable
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
   123
!DeviceGraphicsContext  class methodsFor:'cleanup'!
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
lowSpaceCleanup
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
    CachedScaledForms := CachedScales := nil
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
!DeviceGraphicsContext methodsFor:'accessing'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
at:aPoint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    "return the pixel at the coordinate given by aPoint"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
    ^ device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
	getPixelX:(aPoint x)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
		y:(aPoint y)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
	     from:drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
at:aPoint put:aPixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
    "set a pixel"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
    |oldFg|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
    self foreground:aPixel.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    self displayPointX:(aPoint x) y:(aPoint y).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
    self foreground:oldFg
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
atX:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
    "return the pixel at the coordinate given by x/y"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
    ^ device getPixelX:x y:y from:drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
atX:x y:y put:aPixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
    "set a pixel"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
    |oldFg|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
    self foreground:aPixel.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
    self displayPointX:x y:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
    self foreground:oldFg
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
backgroundPaint:aColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
    "set the background-paint color; this is used in opaque-draw
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
     operations"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
    (aColor ~~ bgPaint) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
	aColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
	    bgPaint := aColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
	    gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
		bgPaint isColor ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
		    bgPaint := aColor on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
		    bgPaint colorId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
			background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
			device setBackground:(bgPaint colorId) in:drawableId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
			^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
		    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
		].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
		self paint:paint on:aColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
	    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
	]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
basicFont
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
    "return set the font for drawing"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
    ^ font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
    "Created: 12.5.1996 / 11:17:59 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
basicFont:aFont
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
    "set the font for drawing if it has changed.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
     This is a low level entry, which is not to be redefined
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
     (i.e. it must not imply a redraw operation)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
    |id|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
    (aFont ~~ font) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
        aFont notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
            font := aFont.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
            gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
                font := font on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
                id := font fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
                id notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
                    device setFont:id in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
    "Modified: 23.2.1996 / 17:01:06 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
    "Created: 23.2.1996 / 17:16:51 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
capStyle:aSymbol
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
    "set the style in which the endpoints of lines
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
     are drawn - aSymbol may be #notLast, #butt, #round, #projecting"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
    |s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
    (s := aSymbol) isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
        s := #butt.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
    (s ~~ capStyle) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
        capStyle := s.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
            device setLineWidth:lineWidth 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
                          style:lineStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
                            cap:s
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
                           join:joinStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
                             in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
    "Modified: 12.5.1996 / 22:23:03 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
950
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   246
clipByChildren
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   247
    "drawing shall be done into my view only (default)"
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   248
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   249
    ^ self clippedByChildren:true
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   250
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   251
    "Created: 17.7.1996 / 13:25:55 / cg"
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   252
!
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   253
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
clipRect
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
    "return the clipping rectangle for drawing. If there is currently no clipRect,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
     a dummy is created."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
    |rect|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
    clipRect isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
        rect := 0@0 extent:(self extent).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
        transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
            rect := transformation applyInverseTo:rect.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
        ^ rect
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
    ^ clipRect
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
    "Modified: 10.4.1996 / 14:32:22 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
950
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   272
clippedByChildren:aBoolean
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   273
    "turn on/off drawing over children.
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   274
     If on, a superview may draw 'over' its children.
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   275
     If off (the default), drawing is 'under' its children.
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   276
     Only useful for the rootView, to draw over any visible views.
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   277
     (for example, when dragging a rubber-line)"
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   278
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   279
    gcId isNil ifTrue:[
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   280
        self initGC
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   281
    ].
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   282
    device setClipByChildren:aBoolean in:gcId
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   283
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   284
    "Created: 17.7.1996 / 13:25:16 / cg"
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   285
!
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   286
735
44ad59ece2db checkin from browser
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
   287
clippingRectangle:aRectangleOrNil
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
    "set the clipping rectangle for drawing (in logical coordinates);
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
     a nil argument turn off clipping (i.e. whole view is drawable)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
    |x y w h|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
    aRectangleOrNil isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
        clipRect isNil ifTrue:[^ self].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
            device noClipIn:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
        clipRect notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
            (clipRect = aRectangleOrNil) ifTrue:[^ self]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
            x := aRectangleOrNil left.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
            y := aRectangleOrNil top.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
            w := aRectangleOrNil width.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
            h := aRectangleOrNil height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
            transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
                x := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
                y := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
                w := transformation applyScaleX:w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
                h := transformation applyScaleY:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
            (x class == SmallInteger) ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
                w := w + (x - x truncated).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
                x := x truncated
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
            (y class == SmallInteger) ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
                h := h + (y - y truncated).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
                y := y truncated
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
            (w class == SmallInteger) ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
                w := w truncated + 1
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
            (h class == SmallInteger) ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
                h := h truncated + 1
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   327
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   328
            device setClipX:x y:y width:w height:h in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
    clipRect := aRectangleOrNil
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
    "Modified: 22.5.1996 / 13:12:07 / cg"
735
44ad59ece2db checkin from browser
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
   334
    "Created: 28.5.1996 / 19:40:20 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
clippingRectangleOrNil
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
    "return the clipping rectangle for drawing, nil if there is none."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
    ^ clipRect
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   342
    "Created: 10.4.1996 / 14:32:02 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
786
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   345
dashStyle:aDashList offset:dashOffset
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   346
    "define dashes. Each element of the dashList specifies the length
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   347
     of a corresponding dash. For example, setting it to [4 4]
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   348
     defines 4on-4off dashing; 
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   349
     Setting it to [1 2 4 2] defines 1on-2off-4on-2off dashes.
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   350
     The dashOffset specifies where in the dashList the dashing starts.
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   351
     This may not be supported by all graphics devices."
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   352
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   353
    gcId notNil ifTrue:[
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   354
        device setDashes:(ByteArray withAll:aDashList)
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   355
              dashOffset:dashOffset
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   356
                      in:gcId
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   357
    ]
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   358
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   359
    "Modified: 4.6.1996 / 19:03:06 / cg"
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   360
!
af5fecf93126 added dashStyle: ...
Claus Gittinger <cg@exept.de>
parents: 784
diff changeset
   361
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   363
    "return the device, the receiver is associated with"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   365
    ^ device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   368
device:aDevice
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   369
    "set the device"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   370
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   371
    device := aDevice
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   372
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   373
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   374
font:aFont
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
    "set the font for drawing if it has changed.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
     This should be redefined in some widget to perform an automatic
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
     redraw. See also: #basicFont:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   378
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   379
    (aFont ~~ font) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   380
        self basicFont:aFont
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   383
    "Modified: 6.3.1996 / 18:17:40 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   384
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   385
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   386
function:aSymbol
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   387
    "set the drawing function if it has changed"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   389
    (aSymbol ~~ function) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
	function := aSymbol.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
	gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
	    device setFunction:aSymbol in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   393
	]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   394
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   395
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   396
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   397
gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   398
    "return the receivers graphic context id on the device"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   399
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   400
    ^ gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
graphicsDevice
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
    "return the device, the receiver is associated with.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
     Same as #device, for ST-80 compatibility."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
    ^ device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
    "Created: 9.5.1996 / 01:37:58 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
id
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
    "return the id of the dravable on the device"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
    ^ drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
joinStyle:aSymbol
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
    "set the style in which 2 lines are connected in polygons -
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
     aSymbol may be #miter, #bevel, #round"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
    |s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
    (s := aSymbol) isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
        s := #miter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
    (s ~~ joinStyle) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
        joinStyle := s.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
        
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   430
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   431
            device setLineWidth:lineWidth 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
                          style:lineStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
                            cap:capStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
                           join:s
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
                             in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   437
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   438
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   439
    "Modified: 12.5.1996 / 22:20:43 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   442
lineStyle:aSymbol
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   443
    "set the style in which lines are drawn -
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   444
     aSymbol may be #solid, #dashed, #doubleDashed"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
    |s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   447
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
    (s := aSymbol) isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   449
        s := #solid
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
    (s ~~ lineStyle) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
        lineStyle := s.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
            device setLineWidth:lineWidth 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
                          style:s
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
                            cap:capStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
                           join:joinStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
                             in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
    "Modified: 12.5.1996 / 22:21:25 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
lineWidth:aNumber
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
    "set the line width for drawing if it has changed"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
    |n|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
    (aNumber ~~ lineWidth) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
	lineWidth := aNumber.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
	transformation isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
	    n := aNumber.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
	] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
	    n := transformation applyScaleX:aNumber.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
	    n := n rounded
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   477
	].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
	gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
	    device setLineWidth:n 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
			  style:lineStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
			    cap:capStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
			   join:joinStyle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
			     in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
	]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
mask:aForm
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
    "set the mask form for drawing"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
    |id|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
    (aForm ~~ mask) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
	mask := aForm.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
	gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
	    (mask == nil) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
		device setBitmapMask:nil in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
	    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
		mask := mask on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
		id := mask id.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
		(mask depth == 1) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
		    device setBitmapMask:id in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
		] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
		    device setPixmapMask:id in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   505
		]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
	    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
	]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
950
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   511
noClipByChildren
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   512
    "drawing shall also be done into subviews"
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   513
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   514
    ^ self clippedByChildren:false
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   515
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   516
    "Created: 17.7.1996 / 14:15:54 / cg"
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   517
!
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
   518
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
paint:aColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
    "set the drawing color, which may be a real color, a dithered one
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   521
     or even an image."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   522
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
    (aColor ~~ paint) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   524
        aColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   525
            paint := aColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   526
            self setGCForPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   527
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   528
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
    "Modified: 16.5.1996 / 15:35:57 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   531
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   532
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
paint:fgColor on:bgColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   534
    "set the paint and background-paint color. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   535
     The bg-paint is used in opaque-draw operations"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   537
    |fgId bgId|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   538
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
    ((fgColor ~~ paint) or:[bgColor ~~ bgPaint]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   540
        fgColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   541
            paint := fgColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   543
        bgColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
            bgPaint := bgColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   545
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   546
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   547
            paint := paint on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   548
            paint isColor ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
                fgId := paint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   550
                fgId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   551
                    mask notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   552
                        mask := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   553
                        device setBitmapMask:nil in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   554
                    ]. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
                    bgPaint := bgPaint on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
                    bgPaint isColor ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
                        bgId := bgPaint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
                        bgId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
                            "the common case, both are real colors"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   560
                            (paint ~~ foreground) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
                                foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
                                (bgPaint ~~ background) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
                                    background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
                                    device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
                                    ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
                                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
                                device setForeground:fgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
                                ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   569
                            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   570
                            (bgPaint ~~ background) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   571
                                background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
                                device setBackground:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   573
                            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   574
                            ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   575
                        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   576
                        "bgPaint is dithered, setup paint here, leave bgPaint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
                         till next opaque draw comes around."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   578
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   579
                        (paint ~~ foreground) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   580
                            foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   581
                            device setForeground:fgId in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   582
                        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   583
                        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   584
                    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
            "either paint or bgPaint (or both) are dithered colors,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   588
             setup for paint, leave bg-problem till next opaque draw
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
             comes around.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
            "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   591
            self setGCForPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
    "Modified: 16.5.1996 / 15:37:05 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   596
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   597
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
paint:fgColor on:bgColor function:f
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   599
    "set paint, background-paint and function"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   600
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   601
    self paint:fgColor on:bgColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   602
    self function:f
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   603
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
    "Modified: 16.5.1996 / 15:36:35 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   605
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   606
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
setGraphicsExposures:aBoolean
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
    "want to if aBoolean is true - or dont want to be notified
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
     of graphics exposures"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   611
    gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
	device setGraphicsExposures:aBoolean in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   615
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   616
setMaskOrigin:aPoint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
    "set the origin of the fill pattern"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   619
    (maskOrigin isNil or:[maskOrigin ~= aPoint]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   620
	transformation isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
	    maskOrigin := aPoint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
	] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
	    maskOrigin := transformation applyTo:aPoint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
	].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
	gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
	    device setMaskOriginX:maskOrigin x rounded 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
				y:maskOrigin y rounded 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
			       in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   629
	]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   631
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   632
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   633
setMaskOriginX:orgX y:orgY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   634
    "set the origin of the pattern"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   635
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
    |x y|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   637
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   639
	x := transformation applyToX:orgX.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
	y := transformation applyToY:orgY.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   641
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
	x := orgX.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
	y := orgY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   645
    x := x rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
    y := y rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   647
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   648
    (maskOrigin isNil or:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
     ((x ~~ maskOrigin x) or:[y ~~ maskOrigin y]) ]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   651
	maskOrigin := x @ y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   652
	gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   653
	    device setMaskOriginX:x y:y in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   654
	]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   655
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   656
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   657
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
!DeviceGraphicsContext methodsFor:'accessing - internals'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   659
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   660
background
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   661
    "return the current background drawing color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   662
     OBSOLETE: use #paint: / #backgroundPaint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   663
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   664
    ^ background
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
    "Modified: 12.5.1996 / 22:28:09 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   667
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
background:aColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
    "set the internal background color for drawing - aColor must be a real color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   671
     OBSOLETE: this method will vanish; use #paint: / #backgroundPaint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   672
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
    |bgId|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
    (aColor ~~ background) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
        aColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
            background := aColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   678
            gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   679
                background := background on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   680
                bgId := background colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   681
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   682
                "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   683
                 mhmh the following is a kludge ....
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
                "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   685
                bgId isNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   686
                    (background grayIntensity >= 50) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   687
                        bgId := device whitepixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
                    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   689
                        bgId := device blackpixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   690
                    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   691
                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   692
                device setBackground:bgId in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   697
    "Modified: 28.5.1996 / 20:44:55 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
    "return the current foreground drawing color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   702
     OBSOLETE: use #paint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
    ^ foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   706
    "Modified: 12.5.1996 / 22:28:03 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   707
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   708
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
foreground:aColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
    "set the internal foreground color for drawing - aColor must be a real color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
    |fgId|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
    (aColor ~~ foreground) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
        aColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
            foreground := aColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
            gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
                (foreground class == SmallInteger) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
                    fgId := foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
                ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
                    foreground := foreground on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
                    fgId := foreground colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   726
                "mhmh the following is a kludge ...."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
                fgId isNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   728
                    (foreground grayIntensity >= 50) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
                        fgId := device whitepixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
                    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   731
                        fgId := device blackpixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   732
                    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
                device setForeground:fgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
                paint := foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   740
    "Modified: 28.5.1996 / 20:45:02 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
foreground:fgColor background:bgColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
    "set both internal foreground and internal background colors 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
     - these must be real colors.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
    |fgPixel bgPixel|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
    ((fgColor ~~ foreground) or:[bgColor ~~ background]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
        fgColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
            foreground := fgColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
        bgColor notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
            background := bgColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
            foreground := foreground on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
            background := background on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
            fgPixel := foreground colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
            bgPixel := background colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
            "mhmh the following is a kludge ...."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
            fgPixel isNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   765
                (foreground grayIntensity >= 50) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
                    fgPixel := device whitepixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   767
                ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
                    fgPixel := device blackpixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
            bgPixel isNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   772
                (background grayIntensity >= 50) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
                    bgPixel := device whitepixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
                ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
                    bgPixel := device blackpixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
            device setForeground:fgPixel background:bgPixel in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
            paint := foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   783
    "Modified: 28.5.1996 / 20:45:27 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
foreground:fgColor background:bgColor function:fun
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
    "set foreground, background colors and function.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
    self foreground:fgColor background:bgColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
    self function:fun
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   792
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
    "Modified: 12.5.1996 / 22:28:34 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
foreground:aColor function:fun
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
    "set the foreground color and function for drawing.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
     OBSOLETE: this method will vanish; use #paint: / #paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   799
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
    |fgPixel|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   801
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   802
    ((aColor ~~ foreground) or:[fun ~~ function]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
        foreground := aColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
        function := fun.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
        gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
            foreground := foreground on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
            fgPixel := foreground colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
            "mhmh the following is a kludge ...."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
            fgPixel isNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   811
                (foreground grayIntensity >= 50) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   812
                    fgPixel := device whitepixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
                ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   814
                    fgPixel := device blackpixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   815
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   816
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   817
            device setForeground:fgPixel in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   818
            device setFunction:fun in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   819
            paint := foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   820
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   821
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
   823
    "Modified: 28.5.1996 / 20:45:09 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   825
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   826
!DeviceGraphicsContext methodsFor:'bit blitting'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   827
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
copyBitsFrom:aByteArray bitsPerPixel:bpp depth:depth width:srcW height:srcH x:srcX y:srcY toX:dstX y:dstY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
    "copy bits from a smalltalk byteArray.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
     The bits found there are supposed to be in the devices native format (i.e.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   831
     translated to allocated color indices on pseudoColor devices and padded as required.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   832
     The byteOrder is MSB and will be converted as appropriate by the underlying devices 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   833
     method to whatever the device needs."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
    device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
	drawBits:aByteArray bitsPerPixel:bpp depth:depth  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
	   width:srcW height:srcH
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
	       x:srcX y:srcY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
	    into:drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   840
	       x:dstX y:dstY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
	   width:(self width) height:(self height)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
	    with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
    "Created: 21.10.1995 / 00:04:22 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
    "copy from aDrawable into the receiver;
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
     the source may be the receiver as well - in this case its a scroll.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
     All coordinates are in device coordinates."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
    |id|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
    id := aDrawable id.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
    "temporary ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
     this fixes a problem after restart on another display,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   858
     when a file-bitmap wasnt found. In this case, the id of the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
     bitmap will be nil. This will be fixed soon.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   861
    (id isNil 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   862
    or:[aDrawable graphicsDevice ~~ device]) ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   863
        'DEVGC: invalid bitmap copy - ignored' errorPrintNL.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   864
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   865
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   866
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
    gcId isNil ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   868
        self initGC
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   869
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   870
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   871
    "this is a workaround for a bug (or a feature ?) in many X-servers;
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
     copy is only copy if fg==1 and bg==0"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
"/No: it was my fault - shame, shame
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
"/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
"/    ((aDrawable == self) and:[function == #copy]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
"/        device setForeground:1 background:0 in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   878
"/        background := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
"/        foreground := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
"/        paint := nil
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
"/    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
"/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
    ((aDrawable depth == 1) and:[device depth ~~ 1]) ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   884
        device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   885
            copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   886
                     x:srcX y:srcY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   887
                    to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   888
                     x:dstX y:dstY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   889
                 width:w
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   890
                height:h
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   891
                  with:gcId
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   892
    ] ifFalse:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   893
        device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   894
            copyFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   895
                     x:srcX y:srcY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   896
                    to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   897
                     x:dstX y:dstY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   898
                 width:w
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   899
                height:h
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   900
                  with:gcId
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   901
    ]
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   902
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   903
    "Modified: 15.6.1996 / 15:36:38 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   904
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   905
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   906
copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   907
    "copy one plane from aDrawable into the receiver. 0's are drawn in
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   908
     background, while 1's are drawn with foreground color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   909
     The depth of aDrawable must (should) be 1.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   910
     The drawable must have been allocated on the same device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   911
     All coordinates are in device coordinates."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   912
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   913
    |id|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   914
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   915
    id := aDrawable id.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   916
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   917
    "temporary ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   918
     this fixes a problem after restart on another display,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   919
     when a file-bitmap wasnt found. In this case, the id of the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   920
     bitmap will be nil. This will be fixed soon.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   921
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   922
    (id isNil 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   923
    or:[aDrawable graphicsDevice ~~ device]) ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   924
        'DEVGC: invalid copyPlane - ignored' errorPrintNL.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   925
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   926
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   927
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   928
    gcId isNil ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   929
        self initGC
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   930
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   931
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   932
    device
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   933
        copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   934
                 x:srcX y:srcY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   935
                to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   936
                 x:dstX y:dstY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   937
             width:w
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   938
            height:h
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   939
              with:gcId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   940
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
   941
    "Modified: 15.6.1996 / 15:36:42 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   942
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   943
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   944
!DeviceGraphicsContext methodsFor:'copying'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   945
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   946
postCopy
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   947
    "this may not be enough to allow copying of views ..."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   948
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   949
    super postCopy.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   950
    device := drawableId := gcId := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   951
    self recreate
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   952
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   953
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   954
!DeviceGraphicsContext methodsFor:'drawing'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   955
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   956
displayArcX:x y:y width:w height:h from:startAngle angle:angle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   957
    "draw an arc; apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   958
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
   959
    |pX pY rpX rpY nW nH|
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   960
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   961
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   962
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   963
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   964
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   965
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   966
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   967
        nW := transformation applyScaleX:w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   968
        nH := transformation applyScaleY:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   969
        nW < 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   970
              nW := nW abs.  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   971
              pX := pX - nW.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   972
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   973
        nH < 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   974
              nH := nH abs.  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   975
              pY := pY - nH.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   976
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   977
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   978
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   979
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   980
        nW := w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   981
        nH := h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   982
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   983
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   984
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   985
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   986
    nW := nW rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   987
    nH := nH rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   988
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   989
    device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   990
          displayArcX:pX 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   991
                    y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   992
                width:nW 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   993
               height:nH 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   994
                 from:startAngle 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   995
                angle:angle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   996
                   in:drawableId 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   997
                 with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   998
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
   999
"/    rpX := pX rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1000
"/    rpY := pY rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1001
"/    nW := (nW + (rpX - pX)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1002
"/    nH := (nH + (rpY - pY)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1003
"/
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1004
"/    device
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1005
"/          displayArcX:rpX 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1006
"/                    y:rpY 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1007
"/                width:nW 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1008
"/               height:nH 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1009
"/                 from:startAngle 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1010
"/                angle:angle
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1011
"/                   in:drawableId 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1012
"/                 with:gcId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1013
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1014
    "Created: 8.5.1996 / 08:31:30 / cg"
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1015
    "Modified: 4.6.1996 / 17:59:28 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1016
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1017
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1018
displayForm:formToDraw x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1019
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1020
     current paint-color, leaving pixels with 0-bits unchanged
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1021
     (i.e. only 1-bits are drawn from the form).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1022
     If its a deep form (i.e. a pixmap) the current paint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1023
     settings are ignored and the form is drawn as-is. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1024
     Care must be taken, that the paint color is correctly allocated 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1025
     (by sending #on: to the color) before doing so.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1026
     Using functions other than #copy only makes sense if you are
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1027
     certain, that the colors are real colors (actually, only for
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1028
     noColor or allColor)."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1029
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1030
    |realForm pX pY w h nW nH|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1031
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1032
    realForm := formToDraw.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1033
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1034
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1035
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1036
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1037
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1038
        transformation noScale ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1039
            w := formToDraw width.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1040
            h := formToDraw height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1041
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1042
            nW := (transformation applyScaleX:w) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1043
            nH := (transformation applyScaleY:h) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1044
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1045
            ((nW ~= w) or:[nH ~= h]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1046
                "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1047
                "/ hard case - someone is drawing forms with scaling in effect
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1048
                "/ look if we have a scaled version in our pocket ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1049
                "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1050
                realForm := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1051
                CachedScaledForms notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1052
                    (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1053
                        realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1054
                    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1055
                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1056
                realForm isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1057
                    "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1058
                    "/ nope - must do the work ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1059
                    "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1060
                    realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1061
                    CachedScaledForms isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1062
                        CachedScaledForms := WeakIdentityDictionary new.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1063
                        CachedScales := WeakIdentityDictionary new.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1064
                    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1065
                    CachedScaledForms at:formToDraw put:realForm.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1066
                    CachedScales at:formToDraw put:transformation scale.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1067
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1068
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1069
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1070
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1071
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1072
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1073
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1074
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1075
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1076
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1077
    self displayDeviceForm:realForm x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1078
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1079
    "Modified: 21.5.1996 / 21:15:44 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1080
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1081
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1082
displayLineFromX:x0 y:y0 toX:x1 y:y1
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1083
    "draw a line (with current paint-color); apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1084
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1085
    |pX0 pY0 pX1 pY1 easy fgId bgId|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1086
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1087
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1088
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1089
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1090
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1091
    lineStyle == #doubleDashed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1092
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1093
         if bgPaint or paint is not a real color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1094
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1095
        easy := true.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1096
        paint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1097
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1098
        ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1099
            fgId := paint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1100
            fgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1101
                easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1102
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1103
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1104
        bgPaint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1105
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1106
        ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1107
            bgId := bgPaint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1108
            bgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1109
                easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1110
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1111
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1112
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1113
        easy ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1114
            ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1115
                device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1116
                foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1117
                background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1118
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1119
        ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1120
            'DEVDRAW: cannot draw dashes with dithered colors' errorPrintNL
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1121
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1122
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1123
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1124
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1125
        pX0 := transformation applyToX:x0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1126
        pY0 := transformation applyToY:y0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1127
        pX1 := transformation applyToX:x1.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1128
        pY1 := transformation applyToY:y1.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1129
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1130
        pX0 := x0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1131
        pY0 := y0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1132
        pX1 := x1.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1133
        pY1 := y1
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1134
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1135
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1136
    pX0 := pX0 rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1137
    pY0 := pY0 rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1138
    pX1 := pX1 rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1139
    pY1 := pY1 rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1140
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1141
    device displayLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1142
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1143
    "Modified: 13.4.1996 / 20:31:19 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1144
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1145
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1146
displayOpaqueForm:formToDraw x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1147
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1148
     current paint-color and 0-bits in the bgPaint color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1149
     If its a deep form (i.e. a pixmap) the current paint/bgPaint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1150
     settings are ignored and the form drawn as-is. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1151
     In the 1-plane case, special care must be taken if paint and/or bgPaint 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1152
     dithered colors or patterns, since are that the colors are correctly allocated 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1153
     (by sending #on: to the colors) before doing so.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1154
     If there is a transformation, the image is scaled as appropiate."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1155
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1156
    |w h realForm pX pY nW nH|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1157
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1158
    bgPaint isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1159
        "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1160
        "/ actually not an opaque draw
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1161
        "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1162
        self displayForm:formToDraw x:x y:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1163
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1164
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1165
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1166
    realForm := formToDraw.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1167
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1168
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1169
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1170
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1171
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1172
        transformation noScale ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1173
            w := formToDraw width.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1174
            h := formToDraw height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1175
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1176
            nW := (transformation applyScaleX:w) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1177
            nH := (transformation applyScaleY:h) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1178
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1179
            ((nW ~= w) or:[nH ~= h]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1180
                "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1181
                "/ hard case - someone is drawing forms with scaling in effect
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1182
                "/ look if we have a scaled version in our pocket ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1183
                "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1184
                realForm := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1185
                CachedScaledForms notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1186
                    (CachedScales at:formToDraw ifAbsent:nil) = transformation scale ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1187
                        realForm := CachedScaledForms at:formToDraw ifAbsent:nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1188
                    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1189
                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1190
                realForm isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1191
                    "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1192
                    "/ nope - must do the work ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1193
                    "/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1194
                    realForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1195
                    CachedScaledForms isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1196
                        CachedScaledForms := WeakIdentityDictionary new.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1197
                        CachedScales := WeakIdentityDictionary new.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1198
                    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1199
                    CachedScaledForms at:formToDraw put:realForm.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1200
                    CachedScales at:formToDraw put:transformation scale.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1201
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1202
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1203
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1204
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1205
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1206
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1207
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1208
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1209
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1210
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1211
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1212
    self displayDeviceOpaqueForm:realForm x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1213
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1214
    "Modified: 21.5.1996 / 21:15:54 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1215
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1216
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1217
displayOpaqueString:aString from:index1 to:index2 x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1218
    "draw a substring at the coordinate x/y - draw foreground pixels in
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1219
     paint-color and background pixels in bgPaint-color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1220
     If the transformation involves scaling, 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1221
     the fonts point-size is scaled as appropriate.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1222
     Assuming that device can only draw in device colors, we have to handle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1223
     the case where paint and/or bgPaint are dithered colors"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1224
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1225
    |easy w h savedPaint fgId bgId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1226
     id pX pY fontUsed sz s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1227
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1228
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1229
     if backgroundPaint color is nil, we assume
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1230
     this is a non-opaque draw
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1231
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1232
    bgPaint isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1233
        self displayString:aString from:index1 to:index2 x:x y:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1234
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1235
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1236
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1237
    (aString isString not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1238
    or:[aString isText]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1239
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1240
         hook for non-strings (i.e. attributed text)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1241
         that 'thing' should know how to display itself ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1242
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1243
        aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1244
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1245
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1246
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1247
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1248
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1249
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1250
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1251
    fontUsed := font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1252
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1253
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1254
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1255
        transformation noScale ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1256
            sz := font size.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1257
            sz isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1258
                "/ oops - not a real font; use original font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1259
                fontUsed := font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1260
            ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1261
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1262
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1263
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1264
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1265
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1266
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1267
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1268
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1269
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1270
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1271
    fontUsed := fontUsed on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1272
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1273
    id := fontUsed fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1274
    id isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1275
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1276
         hook for alien fonts
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1277
         that 'font' should know how to display the string ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1278
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1279
        fontUsed displayOpaqueString:aString from:index1 to:index2 x:x y:y in:self.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1280
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1281
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1282
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1283
    s := aString.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1284
    s encoding ~~ font encoding ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1285
        s := s encodeInto:(font encoding).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1286
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1287
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1288
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1289
     if bgPaint or paint is not a real Color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1290
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1291
    easy := true.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1292
    paint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1293
        easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1294
    ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1295
        fgId := paint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1296
        fgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1297
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1298
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1299
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1300
    bgPaint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1301
        easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1302
    ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1303
        bgId := bgPaint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1304
        bgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1305
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1306
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1307
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1308
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1309
    easy ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1310
        deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1311
            device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1312
            deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1313
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1314
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1315
        device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1316
        foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1317
        background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1318
        device displayOpaqueString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1319
                              from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1320
                                 x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1321
                                in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1322
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1323
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1324
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1325
    w := fontUsed widthOf:s from:index1 to:index2.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1326
    h := fontUsed height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1327
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1328
    (fgId notNil and:[function == #copy]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1329
        deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1330
            device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1331
            deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1332
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1333
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1334
         only bg is dithered; fill with bg first ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1335
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1336
        savedPaint := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1337
        self paint:bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1338
        self fillDeviceRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1339
        self paint:savedPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1340
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1341
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1342
         then draw using fgPaint (which is a real color)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1343
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1344
        device displayString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1345
                        from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1346
                           x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1347
                          in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1348
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1349
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1350
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  1351
    "/ the very hard case (fg-dither)
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  1352
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1353
    self displayDeviceOpaqueString:s from:index1 to:index2 in:fontUsed x:pX y:pY.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1354
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  1355
    "Modified: 12.6.1996 / 12:36:33 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1356
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1357
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1358
displayOpaqueString:aString x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1359
    "draw a string at the coordinate x/y - draw foreground pixels in paint-color,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1360
     background pixels in bgPaint color. If the transformation involves scaling, 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1361
     the fonts point-size is scaled as appropriate.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1362
     Assuming that device can only draw in device colors, we have to handle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1363
     the case where paint and/or bgPaint are dithered colors or images."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1364
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1365
    |id easy fgId bgId pX pY fontUsed sz s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1366
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1367
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1368
     if backgroundPaint color is nil, we assume
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1369
     this is a non-opaque draw
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1370
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1371
    bgPaint isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1372
        self displayString:aString x:x y:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1373
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1374
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1375
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1376
    (aString isString not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1377
    or:[aString isText]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1378
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1379
         hook for non-strings (i.e. attributed text)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1380
         that 'thing' should know how to display itself ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1381
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1382
        aString displayOpaqueOn:self x:x y:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1383
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1384
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1385
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1386
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1387
     if bgPaint or paint is not a real Color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1388
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1389
    easy := true.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1390
    paint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1391
        easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1392
    ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1393
        fgId := paint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1394
        fgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1395
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1396
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1397
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1398
    bgPaint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1399
        easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1400
    ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1401
        bgId := bgPaint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1402
        bgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1403
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1404
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1405
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1406
    easy ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1407
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1408
         for the hard case, use the general drawing method
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1409
         (no need for optimizations - its slow anyway)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1410
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1411
        self displayOpaqueString:aString 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1412
                            from:1 to:(aString size)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1413
                               x:x y:y. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1414
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1415
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1416
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1417
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1418
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1419
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1420
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1421
    fontUsed := font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1422
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1423
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1424
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1425
        transformation noScale ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1426
            sz := font size.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1427
            sz isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1428
                "/ oops - not a real font; use original font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1429
                fontUsed := font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1430
            ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1431
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1432
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1433
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1434
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1435
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1436
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1437
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1438
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1439
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1440
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1441
    fontUsed := fontUsed on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1442
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1443
    id := fontUsed fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1444
    id isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1445
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1446
         hook for alien fonts
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1447
         that 'font' should know how to display the string ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1448
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1449
        fontUsed displayOpaqueString:aString from:1 to:(aString size) x:x y:y in:self.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1450
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1451
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1452
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1453
    s := aString.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1454
    s encoding ~~ font encoding ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1455
        s := s encodeInto:(font encoding).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1456
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1457
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1458
    deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1459
        device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1460
        deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1461
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1462
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1463
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1464
    device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1465
    foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1466
    background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1467
    device displayOpaqueString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1468
                             x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1469
                            in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1470
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1471
    "Modified: 21.5.1996 / 21:16:17 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1472
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1473
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1474
displayPointX:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1475
    "draw a point (with current paint-color); apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1476
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1477
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1478
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1479
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1480
	self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1481
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1482
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1483
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1484
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1485
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1486
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1487
	pY := y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1488
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1489
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1490
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1491
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1492
    device displayPointX:pX y:pY in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1493
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1494
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1495
displayPolygon:aPolygon
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1496
    "draw (the outline of) a polygon (with current paint-color).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1497
     Apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1498
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1499
    |newPolygon|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1500
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1501
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1502
	self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1503
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1504
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1505
	newPolygon := aPolygon collect:[:point | transformation applyTo:point].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1506
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1507
	newPolygon := aPolygon
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1508
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1509
    (newPolygon findFirst:[:p | 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1510
	(p isPoint not 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1511
	or:[(p x class ~~ SmallInteger)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1512
	or:[(p y class ~~ SmallInteger)]])
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1513
     ]) ~~ 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1514
	newPolygon := newPolygon collect:[:p | p asPoint rounded]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1515
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1516
        
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1517
    device displayPolygon:newPolygon in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1518
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1519
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1520
displayRectangleX:x y:y width:w height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1521
    "draw a rectangle (with current paint-color).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1522
     If transformation is nonNil, drawing is in logical coordinates."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1523
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1524
    |pX pY rpX rpY nW nH easy fgId bgId|
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1525
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1526
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1527
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1528
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1529
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1530
    lineStyle == #doubleDashed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1531
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1532
         if bgPaint or paint is not a real color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1533
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1534
        easy := true.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1535
        paint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1536
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1537
        ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1538
            fgId := paint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1539
            fgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1540
                easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1541
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1542
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1543
        bgPaint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1544
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1545
        ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1546
            bgId := bgPaint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1547
            bgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1548
                easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1549
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1550
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1551
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1552
        easy ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1553
            ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1554
                device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1555
                foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1556
                background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1557
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1558
        ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1559
            'DEVDRAW: cannot draw dashes with dithered colors' errorPrintNL
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1560
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1561
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1562
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1563
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1564
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1565
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1566
        nW := transformation applyScaleX:w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1567
        nH := transformation applyScaleY:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1568
        nW < 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1569
              nW := nW abs.  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1570
              pX := pX - nW.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1571
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1572
        nH < 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1573
              nH := nH abs.  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1574
              pY := pY - nH.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1575
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1576
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1577
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1578
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1579
        nW := w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1580
        nH := h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1581
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1582
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1583
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1584
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1585
    nW := nW rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1586
    nH := nH rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1587
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1588
    "I asked myself many times if we should draw w/h or (w-1)/(h-1) bits -
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1589
     this one seems mathematically incorrect but allows to draw and fill
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1590
     a rectangle using the same extents.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1591
     I'm not certain if is the right thing to do ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1592
    "
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1593
    device displayRectangleX:pX 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1594
                           y:pY 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1595
                       width:(nW - 1) 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1596
                      height:(nH - 1)
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1597
                          in:drawableId with:gcId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1598
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1599
"/    rpX := pX rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1600
"/    rpY := pY rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1601
"/    nW := (nW + (rpX - pX)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1602
"/    nH := (nH + (rpY - pY)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1603
"/
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1604
"/    "I asked myself many times if we should draw w/h or (w-1)/(h-1) bits -
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1605
"/     this one seems mathematically incorrect but allows to draw and fill
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1606
"/     a rectangle using the same extents.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1607
"/     I'm not certain if is the right thing to do ...
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1608
"/    "
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1609
"/    device displayRectangleX:rpX 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1610
"/                           y:rpY 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1611
"/                       width:(nW - 1) 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1612
"/                      height:(nH - 1)
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1613
"/                          in:drawableId with:gcId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1614
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  1615
    "Modified: 4.6.1996 / 18:00:03 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1616
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1617
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1618
displayString:aString from:index1 to:index2 x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1619
    "draw a substring at the coordinate x/y -  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1620
     draw foreground-pixels only (in current paint-color), 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1621
     leaving background as-is. If the transformation involves scaling,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1622
     the fonts point-size is scaled as appropriate."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1623
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1624
    |id pX pY fontUsed sz s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1625
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1626
    "hook for non-strings (i.e. attributed text)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1627
    aString isString ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1628
        ^ aString displayOn:self x:x y:y from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1629
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1630
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1631
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1632
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1633
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1634
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1635
    fontUsed := font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1636
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1637
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1638
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1639
        transformation noScale ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1640
            sz := font size.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1641
            sz isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1642
                "/ oops - not a real font; use original font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1643
                fontUsed := font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1644
            ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1645
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1646
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1647
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1648
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1649
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1650
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1651
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1652
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1653
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1654
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1655
    fontUsed := fontUsed on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1656
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1657
    id := fontUsed fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1658
    id isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1659
        "hook for alien fonts"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1660
        font displayString:aString from:index1 to:index2 x:x y:y in:self.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1661
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1662
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1663
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1664
    s := aString.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1665
    s encoding ~~ font encoding ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1666
        s := s encodeInto:(font encoding).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1667
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1668
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1669
    deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1670
        device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1671
        deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1672
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1673
    device displayString:s from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1674
                       x:pX y:pY in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1675
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1676
    "Modified: 21.5.1996 / 21:16:24 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1677
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1678
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1679
displayString:aString x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1680
    "draw a string at the coordinate x/y - 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1681
     draw foreground-pixels only (in current paint-color), 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1682
     leaving background as-is. If the transformation involves scaling, 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1683
     the fonts point-size is scaled as appropriate."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1684
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1685
    |id pX pY fontUsed sz s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1686
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1687
    "hook for non-strings (i.e. attributed text)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1688
    (aString isString not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1689
    or:[aString isText]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1690
        ^ aString displayOn:self x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1691
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1692
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1693
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1694
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1695
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1696
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1697
    fontUsed := font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1698
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1699
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1700
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1701
        transformation noScale ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1702
            sz := font size.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1703
            sz isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1704
                "/ oops - not a real font; use original font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1705
                fontUsed := font
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1706
            ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1707
                fontUsed := font size:(transformation applyScaleY:sz) rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1708
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1709
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1710
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1711
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1712
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1713
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1714
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1715
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1716
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1717
    fontUsed := fontUsed on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1718
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1719
    id := fontUsed fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1720
    id isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1721
        "hook for alien fonts"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1722
        fontUsed displayString:aString x:x y:y in:self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1723
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1724
        s := aString.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1725
        s encoding ~~ fontUsed encoding ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1726
            s := s encodeInto:(fontUsed encoding).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1727
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1728
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1729
        deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1730
            device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1731
            deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1732
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1733
        device displayString:s x:pX y:pY in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1734
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1735
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1736
    "Modified: 21.5.1996 / 21:16:30 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1737
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1738
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1739
displayUnscaledForm:formToDraw x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1740
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1741
     current paint-color, leaving pixels with 0-bits unchanged
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1742
     (i.e. only 1-bits are drawn from the form).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1743
     If its a deep form (i.e. a pixmap) the current paint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1744
     settings are ignored and the form is drawn as-is. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1745
     Care must be taken, that the paint color is correctly allocated 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1746
     (by sending #on: to the color) before doing so.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1747
     Using functions other than #copy only makes sense if you are
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1748
     certain, that the colors are real colors (actually, only for
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1749
     noColor or allColor).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1750
     The origins coordinate is transformed, but the image itself is unscaled."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1751
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1752
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1753
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1754
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1755
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1756
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1757
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1758
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1759
	pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1760
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1761
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1762
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1763
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1764
    self displayDeviceForm:formToDraw x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1765
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1766
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1767
displayUnscaledOpaqueForm:formToDraw x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1768
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1769
     current paint-color, 0 bits in background color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1770
     If its a deep form (i.e. a pixmap) the current paint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1771
     settings are ignored and the form is drawn as-is (opaque). 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1772
     The origins coordinate is transformed, but the image itself is unscaled."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1773
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1774
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1775
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1776
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1777
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1778
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1779
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1780
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1781
	pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1782
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1783
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1784
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1785
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1786
    self displayDeviceOpaqueForm:formToDraw x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1787
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1788
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1789
displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1790
    "draw a substring at the transformed coordinate x/y but do not scale the font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1791
     Draw foreground pixels in paint-color, background pixels in bgPaint color."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1792
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1793
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1794
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1795
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1796
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1797
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1798
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1799
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1800
	pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1801
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1802
    self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1803
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1804
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1805
displayUnscaledOpaqueString:aString x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1806
    "draw a string at the transformed coordinate x/y but do not scale the font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1807
     Draw foreground pixels in paint-color, background pixels in bgPaint color."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1808
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1809
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1810
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1811
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1812
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1813
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1814
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1815
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1816
	pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1817
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1818
    self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1819
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1820
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1821
displayUnscaledString:aString from:index1 to:index2 x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1822
    "draw a substring at the transformed coordinate x/y but do not scale the font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1823
     draw foreground-pixels only (in current paint-color), leaving background as-is."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1824
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1825
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1826
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1827
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1828
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1829
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1830
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1831
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1832
	pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1833
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1834
    self displayDeviceString:aString from:index1 to:index2 in:font x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1835
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1836
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1837
displayUnscaledString:aString x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1838
    "draw a string at the transformed coordinate x/y but do not scale the font.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1839
     draw foreground-pixels only (in current paint-color), leaving background as-is."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1840
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1841
    |pX pY|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1842
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1843
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1844
	pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1845
	pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1846
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1847
	pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1848
	pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1849
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1850
    self displayDeviceString:aString from:1 to:(aString size) in:font x:pX y:pY
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1851
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1852
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1853
!DeviceGraphicsContext methodsFor:'drawing in device coordinates'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1854
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1855
displayDeviceForm:aForm x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1856
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1857
     current paint-color, leaving pixels with 0-bits unchanged
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1858
     (i.e. only 1-bits are drawn from the form).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1859
     The form must have been allocated on the same device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1860
     No transformation or scaling is done.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1861
     If its a deep form (i.e. a pixmap) the current paint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1862
     settings are ignored and the form is drawn as-is. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1863
     Care must be taken, that the paint color is correctly allocated 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1864
     (by sending #on: to the color) before doing so.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1865
     Using functions other than #copy only makes sense if you are
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1866
     certain, that the colors are real colors (actually, only for
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1867
     noColor or allColor)."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1868
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1869
    |id w h easy paintDither tmpForm 
895
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1870
     fgId noColor allColor allBits pX pY
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1871
     mask maskId|
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1872
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1873
    w := aForm width.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1874
    h := aForm height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1875
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1876
    pX := x rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1877
    pY := y rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1878
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1879
    id := aForm id.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1880
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1881
    "temporary ..."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1882
    (id isNil 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1883
    or:[aForm graphicsDevice ~~ device]) ifTrue:[
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1884
        id := (aForm on:device) id.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1885
        id isNil ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  1886
            'DEVGC: invalid form draw - ignored' errorPrintNL.
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1887
            ^ self
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1888
        ].
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1889
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1890
    gcId isNil ifTrue:[
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1891
        self initGC
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1892
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1893
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1894
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1895
     a deep form ignores paint/bgPaint settings
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1896
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1897
    (aForm depth ~~ 1) ifTrue:[
895
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1898
        (mask := aForm mask) notNil ifTrue:[
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1899
            mask depth == 1 ifFalse:[
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1900
                'DEVGC: alpha channel not yet supported' errorPrintCR.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1901
            ] ifTrue:[
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1902
                maskId := (mask on:device) id.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1903
                maskId notNil ifTrue:[
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1904
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1905
                     create temp-form;
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1906
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1907
                    tmpForm := Form width:w height:h depth:device depth on:device.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1908
                    tmpForm initGC.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1909
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1910
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1911
                     fill tempform with image
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1912
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1913
                    device
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1914
                        copyFromId:id
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1915
                                 x:0 y:0
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1916
                                to:tmpForm id
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1917
                                 x:0 y:0 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1918
                             width:w 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1919
                            height:h 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1920
                              with:tmpForm gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1921
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1922
                    allColor := Color allColor.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1923
                    allBits := allColor colorId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1924
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1925
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1926
                     stamp out mask in temp form
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1927
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1928
                    device setForeground:allBits background:0 in:tmpForm gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1929
                    device setFunction:#and in:tmpForm gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1930
                    device
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1931
                        copyPlaneFromId:maskId
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1932
                                      x:0 y:0
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1933
                                     to:tmpForm id
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1934
                                      x:0 y:0
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1935
                                  width:w 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1936
                                 height:h 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1937
                                   with:tmpForm gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1938
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1939
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1940
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1941
                     stamp out mask in destination
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1942
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1943
                    device setForeground:0 background:allBits in:gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1944
                    device setFunction:#and in:gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1945
                    device
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1946
                        copyPlaneFromId:maskId
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1947
                                      x:0 y:0
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1948
                                     to:drawableId
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1949
                                      x:pX y:pY
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1950
                                  width:w 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1951
                                 height:h 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1952
                                   with:gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1953
    "/ Delay waitForSeconds:3.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1954
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1955
                     or-in tempform-bits ...
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1956
                    "
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1957
                    device setFunction:#or in:gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1958
                    device
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1959
                        copyFromId:tmpForm id
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1960
                                 x:0 y:0
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1961
                                to:drawableId
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1962
                                 x:pX y:pY 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1963
                             width:w 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1964
                            height:h 
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1965
                              with:gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1966
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1967
                    foreground notNil ifTrue:[
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 902
diff changeset
  1968
                        device setForeground:foreground colorId in:gcId.
895
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1969
                    ].
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1970
                    background notNil ifTrue:[
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 902
diff changeset
  1971
                        device setBackground:background colorId in:gcId.
895
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1972
                    ].
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1973
                    device setFunction:function in:gcId.
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1974
                    ^ self
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1975
                ]
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1976
            ]
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1977
        ].
0d49372cded9 if a deep image has a mask, care for it (stamp out & or-in)
Claus Gittinger <cg@exept.de>
parents: 868
diff changeset
  1978
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1979
        device
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1980
            copyFromId:id
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1981
                     x:0 y:0
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1982
                    to:drawableId
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1983
                     x:pX y:pY 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1984
                 width:w 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1985
                height:h 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1986
                  with:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  1987
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1988
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1989
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1990
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1991
     the following code is somewhat complicated, since it has to deal
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1992
     with dithered paint colors, which cannot be done directly on most
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1993
     devices (actually, a test for the devices capabilities has to be added here)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1994
     (just assume drawing a bitmap with dithered paint color ... sigh)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1995
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1996
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1997
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1998
     if paint is not a real color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1999
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2000
    easy := (function == #copy).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2001
    easy ifTrue:[
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2002
        paint isColor ifFalse:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2003
            paintDither := paint.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2004
            easy := false
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2005
        ] ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2006
            paintDither := paint ditherForm.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2007
            paintDither notNil ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2008
                easy := false.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2009
            ]
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2010
        ].
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2011
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2012
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2013
    allColor := Color allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2014
    allBits := allColor colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2015
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2016
    easy ifTrue:[
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2017
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2018
         paint is a real color
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2019
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2020
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2021
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2022
         if paint color is all-0 or all-1's, we can do it in one
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2023
         operation ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2024
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2025
        fgId := paint colorId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2026
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2027
        ((fgId ~~ ((1 bitShift:device depth)-1))
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2028
        and:[fgId ~~ allBits]) ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2029
            "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2030
             clear fg-bits ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2031
            "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2032
            device setForeground:0 background:allBits in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2033
            device setFunction:#and in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2034
            device
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2035
                copyPlaneFromId:id
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2036
                              x:0 y:0
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2037
                             to:drawableId
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2038
                              x:pX y:pY
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2039
                          width:w 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2040
                         height:h 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2041
                           with:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2042
        ].
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2043
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2044
        fgId ~~ 0 ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2045
            "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2046
             or-in fg-bits ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2047
            "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2048
            device setForeground:fgId background:0 in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2049
            device setFunction:#or in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2050
            device
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2051
                copyPlaneFromId:id
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2052
                              x:0 y:0
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2053
                             to:drawableId
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2054
                              x:pX y:pY
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2055
                          width:w 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2056
                         height:h 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2057
                           with:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2058
        ].
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2059
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2060
         flush foreground/background cache
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2061
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2062
        foreground := nil.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2063
        background := nil.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2064
        device setFunction:function in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2065
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2066
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2067
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2068
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2069
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2070
     hard case; paint is a dithered color
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2071
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2072
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2073
    noColor := Color noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2074
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2075
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2076
     create temp-form;
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2077
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2078
    tmpForm := Form width:w height:h depth:device depth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2079
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2080
     fill tempform
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2081
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2082
    tmpForm paint:paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2083
    tmpForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2084
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2085
     stamp out background
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2086
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2087
    tmpForm paint:allColor on:noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2088
    tmpForm function:#and.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2089
    tmpForm displayOpaqueForm:aForm x:0 y:0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2090
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2091
     stamp out foreground from destination
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2092
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2093
    device setForeground:0 background:allBits in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2094
    device setFunction:#and in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2095
    device
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2096
        copyPlaneFromId:id
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2097
                      x:0 y:0
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2098
                     to:drawableId
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2099
                      x:pX y:pY
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2100
                  width:w 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2101
                 height:h 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2102
                   with:gcId.
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2103
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2104
     or-in temp into destination
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2105
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2106
    device setForeground:allBits background:0 in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2107
    device setFunction:#or in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2108
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2109
    device
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2110
        copyFromId:tmpForm id
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2111
                 x:0 y:0
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2112
                to:drawableId
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2113
                 x:pX y:pY
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2114
             width:w 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2115
            height:h 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2116
              with:gcId.
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2117
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2118
     flush foreground/background cache
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2119
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2120
    foreground := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2121
    background := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2122
    device setFunction:function in:gcId.
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2123
927
c4bc2a7ff733 use #graphicsDevice instead of #device.
Claus Gittinger <cg@exept.de>
parents: 902
diff changeset
  2124
    "Modified: 5.7.1996 / 17:57:02 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2125
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2126
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2127
displayDeviceLineFromX:x0 y:y0 toX:x1 y:y1
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2128
    "draw a line (with current paint-color) in device coordinate space.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2129
     This ignores any transformations. The coordinates must be integers."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2130
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2131
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2132
	self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2133
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2134
    device displayLineFromX:x0 y:y0 toX:x1 y:y1 in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2135
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2136
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2137
displayDeviceOpaqueForm:aForm x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2138
    "draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2139
     current paint-color and 0-bits in the bgPaint color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2140
     If its a deep form (i.e. a pixmap) the current paint/bgPaint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2141
     settings are ignored and the form drawn as-is. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2142
     In the 1-plane case, special care must be taken if paint and/or bgPaint 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2143
     dithered colors or patterns, since are that the colors are correctly allocated (by sending #on:
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2144
     to the colors) before doing so.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2145
     The form must have been allocated on the same device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2146
     Drawing is in device coordinates; no scaling is done."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2147
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2148
    |id w h easy savedPaint bgForm fgForm tmpForm 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2149
     fgId bgId noColor allColor allBits dx dy
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2150
     pX pY deviceDepth|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2151
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2152
    w := aForm width.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2153
    h := aForm height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2154
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2155
    pX := x rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2156
    pY := y rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2157
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2158
    id := aForm id.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2159
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2160
    "temporary ..."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2161
    (id isNil 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2162
    or:[aForm graphicsDevice ~~ device]) ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2163
        id := (aForm on:device) id.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2164
        id isNil ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2165
            'DEVGC: invalid form draw - ignored' errorPrintNL.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2166
            ^ self
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2167
        ].
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2168
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2169
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2170
    gcId isNil ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2171
        self initGC
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2172
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2173
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2174
    "
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2175
     a deep form ignores paint/bgPaint settings
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2176
     and is always drawn opaque.
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2177
    "
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2178
    (aForm depth ~~ 1) ifTrue:[
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2179
        device
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2180
            copyFromId:id
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2181
                     x:0 y:0
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2182
                    to:drawableId
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2183
                     x:pX y:pY 
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2184
                 width:w 
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2185
                height:h 
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2186
                  with:gcId.
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2187
        ^ self
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2188
    ].
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2189
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2190
    "/ if no bgPaint is set, this is a non-opaque draw
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2191
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2192
    bgPaint isNil ifTrue:[
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2193
        self displayDeviceForm:aForm x:x y:y.
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2194
        ^ self
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2195
    ].
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2196
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2197
    "the following code is somewhat complicated, since it has to deal
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2198
     with dithered fg/bg colors, which cannot be done directly on most
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2199
     devices (actually, a test for the devices capabilities has to be added here)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2200
     (just assume drawing a bitmap with dithered fg/bg colors ... sigh)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2201
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2202
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2203
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2204
     if bgPaint or paint is not a real color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2205
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2206
    easy := true.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2207
    paint isColor ifFalse:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2208
        easy := false
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2209
    ] ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2210
        fgId := paint colorId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2211
        fgId isNil ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2212
            easy := false
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2213
        ]
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2214
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2215
    bgPaint isColor ifFalse:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2216
        easy := false
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2217
    ] ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2218
        bgId := bgPaint colorId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2219
        bgId isNil ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2220
            easy := false
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2221
        ]
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2222
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2223
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2224
    easy ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2225
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2226
         easy: both paint and bgPaint are real colors
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2227
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2228
        ((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2229
            device setForeground:fgId background:bgId in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2230
            foreground := paint.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2231
            background := bgPaint.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2232
        ].
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2233
        device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2234
            copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2235
                          x:0 y:0
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2236
                         to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2237
                          x:pX y:pY 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2238
                      width:w 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2239
                     height:h 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2240
                       with:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2241
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2242
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2243
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2244
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2245
     hard case: paint and/or bgPaint are dithered or patterns
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2246
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2247
    allColor := Color allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2248
    allBits := allColor colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2249
    deviceDepth := device depth.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2250
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2251
    (fgId notNil and:[function == #copy]) ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2252
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2253
         only bg is dithered; fill with bg first ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2254
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2255
        savedPaint := paint.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2256
        self paint:bgPaint.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2257
        self fillDeviceRectangleX:pX y:pY width:w height:h.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2258
        self paint:savedPaint.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2259
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2260
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2261
         if paint color is all-0 or all-1's, we can do it in one
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2262
         operation ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2263
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2264
        ((fgId ~~ ((1 bitShift:deviceDepth)-1))
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2265
        and:[fgId ~~ allBits]) ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2266
            "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2267
             clear fg-bits ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2268
            "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2269
            device setForeground:0 background:allBits in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2270
            device setFunction:#and in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2271
            device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2272
                copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2273
                              x:0 y:0
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2274
                             to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2275
                              x:pX y:pY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2276
                          width:w 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2277
                         height:h 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2278
                           with:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2279
        ].
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2280
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2281
        fgId ~~ 0 ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2282
            "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2283
             or-in fg-bits ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2284
            "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2285
            device setForeground:fgId background:0 in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2286
            device setFunction:#or in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2287
            device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2288
                copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2289
                              x:0 y:0
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2290
                             to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2291
                              x:pX y:pY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2292
                          width:w 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2293
                         height:h 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2294
                           with:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2295
        ].
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2296
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2297
         flush foreground/background cache
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2298
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2299
        foreground := nil.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2300
        background := nil.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2301
        device setFunction:function in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2302
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2303
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2304
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2305
    (bgId notNil and:[function == #copy]) ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2306
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2307
         only fg is dithered; fill with fg first ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2308
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2309
        self fillDeviceRectangleX:pX y:pY width:w height:h.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2310
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2311
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2312
         if paint color is all-0 or all-1's, we can do it in one
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2313
         operation ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2314
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2315
        ((bgId ~~ ((1 bitShift:deviceDepth)-1))
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2316
        and:[bgId ~~ allBits]) ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2317
            "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2318
             clear bg-bits ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2319
            "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2320
            device setForeground:allBits background:0 in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2321
            device setFunction:#and in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2322
            device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2323
                copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2324
                              x:0 y:0
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2325
                             to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2326
                              x:pX y:pY
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2327
                          width:w 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2328
                         height:h 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2329
                           with:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2330
        ].
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2331
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2332
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2333
         or-in bg-bits ...
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2334
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2335
        bgId ~~ 0 ifTrue:[
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2336
            device setForeground:0 background:bgId in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2337
            device setFunction:#or in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2338
            device
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2339
                copyPlaneFromId:id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2340
                              x:0 y:0
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2341
                             to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2342
                              x:pX y:pY 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2343
                          width:w 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2344
                         height:h 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2345
                           with:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2346
        ].
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2347
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2348
         flush foreground/background cache
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2349
        "
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2350
        foreground := nil.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2351
        background := nil.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2352
        device setFunction:function in:gcId.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2353
        ^ self
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2354
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2355
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2356
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2357
     very hard case; both fg and bg are dithered colors
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2358
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2359
    noColor := Color noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2360
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2361
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2362
     create temp-forms;
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2363
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2364
    bgForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2365
    fgForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2366
    tmpForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2367
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2368
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2369
     fill
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2370
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2371
    dx := dy := 0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2372
    maskOrigin notNil ifTrue:[
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2373
        dx := maskOrigin x.
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2374
        dy := maskOrigin y
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2375
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2376
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2377
    bgForm paint:bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2378
    bgForm setMaskOriginX:(x negated + dx) y:(y negated + dy).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2379
    bgForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2380
    fgForm paint:paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2381
    fgForm setMaskOriginX:(x negated + dx) y:(y negated + dy).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2382
    fgForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2383
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2384
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2385
     stamp-out background
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2386
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2387
    bgForm paint:noColor on:allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2388
    bgForm function:#and.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2389
    bgForm displayOpaqueForm:aForm x:0 y:0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2390
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2391
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2392
     stamp-out foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2393
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2394
    fgForm paint:allColor on:noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2395
    fgForm function:#and.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2396
    fgForm displayOpaqueForm:aForm x:0 y:0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2397
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2398
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2399
     clear tempform
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2400
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2401
    tmpForm paint:noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2402
    tmpForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2403
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2404
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2405
     merge fg-temp and bg-temp into tmp
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2406
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2407
    tmpForm function:#or.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2408
    tmpForm paint:noColor on:allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2409
    tmpForm copyFrom:fgForm x:0 y:0 toX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2410
    tmpForm copyFrom:bgForm x:0 y:0 toX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2411
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2412
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2413
     finally, draw it
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2414
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2415
    device setForeground:0 background:allBits in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2416
    device
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2417
        copyFromId:tmpForm id
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2418
                 x:0 y:0
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2419
                to:drawableId
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2420
                 x:pX y:pY 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2421
             width:w 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2422
            height:h 
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2423
              with:gcId.
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2424
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2425
     flush foreground/background cache
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2426
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2427
    foreground := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2428
    background := nil.
868
65c93e5f6f8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 844
diff changeset
  2429
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  2430
    "Modified: 22.6.1996 / 16:45:35 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2431
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2432
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2433
displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2434
    "draw a substring at the coordinate x/y - draw foreground pixels in
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2435
     paint-color and background pixels in bgPaint-color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2436
     Assuming that device can only draw in device colors, we have to handle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2437
     the case where paint and/or bgPaint are dithered colors.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2438
     No translation or scaling is done."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2439
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2440
    |easy w h savedPaint fgId bgId allColor allBits noColor
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2441
     id bgForm fgForm tmpForm maskForm dx dy pX pY fontUsed s
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2442
     deviceDepth|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2443
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2444
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2445
     if backgroundPaint color is nil, we assume
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2446
     this is a non-opaque draw
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2447
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2448
    bgPaint isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2449
        self displayDeviceString:aString from:index1 to:index2 x:x y:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2450
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2451
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2452
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2453
    (aString isString not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2454
    or:[aString isText]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2455
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2456
         hook for non-strings (i.e. attributed text)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2457
         that 'thing' should know how to display itself ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2458
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2459
        aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2460
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2461
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2462
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2463
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2464
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2465
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2466
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2467
    pX := x rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2468
    pY := y rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2469
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2470
    fontUsed := font on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2471
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2472
    id := fontUsed fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2473
    id isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2474
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2475
         hook for alien fonts
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2476
         that 'font' should know how to display the string ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2477
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2478
        font displayOpaqueString:aString from:index1 to:index2 x:x y:y in:self.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2479
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2480
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2481
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2482
    s := aString.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2483
    s encoding ~~ font encoding ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2484
        s := s encodeInto:(font encoding).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2485
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2486
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2487
    deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2488
        device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2489
        deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2490
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2491
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2492
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2493
     if bgPaint or paint is not a real Color, we have to do it the hard way ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2494
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2495
    easy := true.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2496
    paint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2497
        easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2498
    ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2499
        fgId := paint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2500
        fgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2501
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2502
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2503
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2504
    bgPaint isColor ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2505
        easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2506
    ] ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2507
        bgId := bgPaint colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2508
        bgId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2509
            easy := false
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2510
        ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2511
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2512
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2513
    easy ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2514
        device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2515
        foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2516
        background := bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2517
        device displayOpaqueString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2518
                              from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2519
                                 x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2520
                                in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2521
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2522
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2523
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2524
    w := fontUsed widthOf:s from:index1 to:index2.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2525
    h := fontUsed height.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2526
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2527
    (fgId notNil and:[function == #copy]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2528
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2529
         only bg is dithered; fill with bg first ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2530
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2531
        savedPaint := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2532
        self paint:bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2533
        self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2534
        self paint:savedPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2535
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2536
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2537
         then draw using fgPaint (which is a real color)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2538
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2539
        device displayString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2540
                        from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2541
                           x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2542
                          in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2543
        ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2544
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2545
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2546
    allColor := Color allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2547
    allBits := allColor colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2548
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2549
    deviceDepth := device depth.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2550
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2551
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2552
     the code below is correct, but some (all?) implementations of the
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2553
     X Window system seem to not support ALU-functions when drawing opaque strings.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2554
     Therefore we use the slower code below.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2555
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2556
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2557
"/    (bgId notNil and:[function == #copy]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2558
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2559
"/       only fg is dithered; fill with fg first ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2560
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2561
"/      self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2562
"/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2563
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2564
"/       if bgPaint color is all-0 or all-1's, we can do it in one
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2565
"/       operation ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2566
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2567
"/      ((bgId ~~ ((1 bitShift:deviceDepth)-1))
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2568
"/      and:[bgId ~~ allBits]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2569
"/          "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2570
"/           clear bg bits ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2571
"/          "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2572
"/          device setForeground:allBits background:0 in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2573
"/          device setFunction:#and in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2574
"/          device displayOpaqueString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2575
"/                                from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2576
"/                                   x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2577
"/                                  in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2578
"/      ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2579
"/
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2580
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2581
"/       or-in bg bits ...
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2582
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2583
"/      bgId ~~ 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2584
"/          device setForeground:0 background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2585
"/          device setFunction:#or in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2586
"/          device displayOpaqueString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2587
"/                                from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2588
"/                                   x:pX y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2589
"/                                  in:drawableId with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2590
"/      ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2591
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2592
"/       flush foreground/background cache
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2593
"/      "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2594
"/      foreground := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2595
"/      background := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2596
"/      device setFunction:function in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2597
"/      ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2598
"/  ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2599
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2600
    (bgId notNil and:[function == #copy]) ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2601
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2602
         only fg is dithered; fill with bg first ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2603
        "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2604
        device setForeground:bgId in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2605
        device setFunction:#copy in:gcId.
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2606
        device setBitmapMask:nil in:gcId.
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2607
        self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2608
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2609
        "/ draw fg dithered
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2610
        (mask depth == 1) ifTrue:[
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2611
            device setBitmapMask:mask id in:gcId.
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2612
            device setForeground:foreground colorId background:background colorId in:gcId.
768
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2613
        ] ifFalse:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2614
            device setPixmapMask:mask id in:gcId
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2615
        ].
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2616
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2617
        device displayString:s
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2618
                    from:index1 to:index2 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2619
                       x:pX y:pY
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2620
                      in:drawableId with:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2621
        ^ self.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2622
"/
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2623
"/      "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2624
"/       if bgPaint color is all-0 or all-1's, we can do it in one
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2625
"/       operation ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2626
"/      "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2627
"/      ((bgId ~~ ((1 bitShift:deviceDepth)-1))
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2628
"/      and:[bgId ~~ allBits]) ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2629
"/          "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2630
"/           clear bg bits ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2631
"/          "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2632
"/          device setForeground:allBits background:0 in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2633
"/          device setFunction:#and in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2634
"/          device displayOpaqueString:s 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2635
"/                                from:index1 to:index2
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2636
"/                                   x:pX y:pY 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2637
"/                                  in:drawableId with:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2638
"/      ].
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2639
"/
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2640
"/      "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2641
"/       or-in bg bits ...
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2642
"/      "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2643
"/      bgId ~~ 0 ifTrue:[
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2644
"/          device setForeground:0 background:bgId in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2645
"/          device setFunction:#or in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2646
"/          device displayOpaqueString:s 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2647
"/                                from:index1 to:index2
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2648
"/                                   x:pX y:pY 
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2649
"/                                  in:drawableId with:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2650
"/      ].
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2651
"/      "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2652
"/       flush foreground/background cache
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2653
"/      "
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2654
"/      foreground := nil.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2655
"/      background := nil.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2656
"/      device setFunction:function in:gcId.
77e4f9d30a22 fixes for b&w screens
Claus Gittinger <cg@exept.de>
parents: 745
diff changeset
  2657
"/      ^ self
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2658
    ].
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2659
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2660
    "
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2661
     very hard case, both fg and bg are dithered colors/images
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2662
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2663
    noColor := Color noColor.
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2664
"/ 'hard: ' print. aString print. ' ' print. paint print. ' ' print. bgPaint printCR.
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2665
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2666
     create temp-forms;
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2667
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2668
    bgForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2669
    fgForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2670
    tmpForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2671
    maskForm := Form width:w height:h depth:deviceDepth on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2672
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2673
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2674
     fill
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2675
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2676
    dx := 0.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2677
    dy := fontUsed ascent.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2678
    maskOrigin notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2679
        dx := maskOrigin x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2680
        dy := dy + maskOrigin y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2681
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2682
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2683
    bgForm paint:bgPaint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2684
    bgForm setMaskOriginX:(pX negated + dx) y:(pY negated + dy).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2685
    bgForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2686
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2687
    fgForm paint:paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2688
    fgForm setMaskOriginX:(pX negated + dx) y:(pY negated + dy).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2689
    fgForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2690
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2691
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2692
     stamp-out background (have now bg-bits with fg=0 in bgForm)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2693
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2694
    bgForm font:fontUsed.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2695
    bgForm paint:noColor on:allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2696
    bgForm function:#and.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2697
    bgForm displayString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2698
                    from:index1 to:index2 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2699
                       x:0 y:fontUsed ascent.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2700
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2701
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2702
     stamp-out foreground
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2703
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2704
    maskForm font:fontUsed.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2705
    maskForm paint:allColor on:noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2706
    maskForm displayOpaqueString:s 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2707
                            from:index1 to:index2 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2708
                               x:0 y:fontUsed ascent.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2709
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2710
    fgForm function:#and.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2711
    fgForm copyFrom:maskForm x:0 y:0 toX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2712
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2713
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2714
     clear tempform
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2715
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2716
    tmpForm paint:noColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2717
    tmpForm fillRectangleX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2718
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2719
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2720
     merge fg-temp and bg-temp into tmp
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2721
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2722
    tmpForm function:#or.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2723
    tmpForm paint:noColor on:allColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2724
    tmpForm copyFrom:fgForm x:0 y:0 toX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2725
    tmpForm copyFrom:bgForm x:0 y:0 toX:0 y:0 width:w height:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2726
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2727
     finally, draw it
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2728
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2729
    device setForeground:0 background:allBits in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2730
    device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2731
        copyFromId:tmpForm id
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2732
                 x:0 y:0
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2733
                to:drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2734
                 x:pX y:pY-fontUsed ascent
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2735
             width:w
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2736
            height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2737
              with:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2738
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2739
     flush foreground/background cache
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2740
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2741
    foreground := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2742
    background := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2743
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  2744
    "Modified: 12.6.1996 / 12:50:12 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2745
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2746
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2747
displayDeviceOpaqueString:aString from:index1 to:index2 x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2748
    "draw a substring at the coordinate x/y - draw foreground pixels in
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2749
     paint-color and background pixels in bgPaint-color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2750
     Assuming that device can only draw in device colors, we have to handle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2751
     the case where paint and/or bgPaint are dithered colors.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2752
     No translation or scaling is done."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2753
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2754
    self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2755
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2756
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2757
displayDeviceOpaqueString:aString x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2758
    "draw a string at the coordinate x/y - draw foreground pixels in
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2759
     paint-color and background pixels in bgPaint-color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2760
     No translation or scaling is done"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2761
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2762
    self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2763
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2764
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2765
displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2766
    "draw a substring at the coordinate x/y -  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2767
     draw foreground-pixels only (in current paint-color), leaving background as-is.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2768
     No translation or scaling is done"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2769
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2770
    |id pX pY fontUsed s|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2771
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2772
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2773
     hook for non-strings (i.e. attributed text)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2774
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2775
    (aString isString not
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2776
    or:[aString isText]) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2777
        ^ aString displayOn:self x:x y:y from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2778
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2779
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2780
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2781
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2782
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2783
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2784
    pX := x rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2785
    pY := y rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2786
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2787
    fontUsed := font on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2788
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2789
    id := fontUsed fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2790
    id isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2791
        "hook for alien fonts"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2792
        font displayString:aString from:index1 to:index2 x:x y:y in:self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2793
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2794
        s := aString.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2795
        s encoding ~~ font encoding ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2796
            s := s encodeInto:(font encoding).
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2797
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2798
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2799
        deviceFont ~~ fontUsed ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2800
            device setFont:id in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2801
            deviceFont := fontUsed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2802
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2803
        device displayString:s from:index1 to:index2
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2804
                           x:pX y:pY in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2805
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2806
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2807
    "Modified: 12.5.1996 / 17:49:22 / cg"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2808
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2809
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2810
displayDeviceString:aString from:index1 to:index2 x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2811
    "draw a substring at the coordinate x/y -  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2812
     draw foreground-pixels only (in current paint-color), leaving background as-is.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2813
     No translation or scaling is done"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2814
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2815
    self displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2816
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2817
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2818
displayDeviceString:aString x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2819
    "draw a string at the coordinate x/y -  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2820
     draw foreground-pixels only (in current paint-color), leaving background as-is.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2821
     No translation or scaling is done"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2822
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2823
    self displayDeviceString:aString from:1 to:(aString size) in:font x:x y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2824
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2825
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2826
fillDeviceRectangleX:x y:y width:w height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2827
    "draw a filled rectangle in device coordinate space.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2828
     This ignores any transformations. The coordinates must be integers."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2829
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2830
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2831
	self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2832
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2833
    device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2834
	fillRectangleX:x 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2835
		     y:y
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2836
		 width:w
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2837
		height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2838
		    in:drawableId with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2839
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2840
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2841
!DeviceGraphicsContext methodsFor:'evaluating in another context'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2842
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2843
reverseDo:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2844
    "evaluate aBlock with foreground and background interchanged.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2845
     This can be reimplemented here in a faster way."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2846
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2847
    |oldFg oldBg|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2848
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2849
    oldFg := foreground on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2850
    oldBg := background on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2851
    self foreground:background background:foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2852
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2853
    self foreground:oldFg background:oldBg
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2854
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2855
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2856
withBackground:fgColor do:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2857
    "evaluate aBlock with changed background."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2858
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2859
    |oldBg|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2860
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2861
    oldBg := background.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2862
    self background:fgColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2863
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2864
    self background:oldBg
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2865
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2866
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2867
withForeground:fgColor background:bgColor do:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2868
    "evaluate aBlock with changed foreground and background."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2869
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2870
    |oldFg oldBg|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2871
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2872
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2873
    oldBg := background.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2874
    self foreground:fgColor background:bgColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2875
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2876
    self foreground:oldFg background:oldBg
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2877
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2878
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2879
withForeground:fgColor background:bgColor function:aFunction do:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2880
    "evaluate aBlock with foreground, background and function"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2881
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2882
    |oldFg oldBg oldFun|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2883
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2884
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2885
    oldBg := background.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2886
    oldFun := function.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2887
    self foreground:fgColor background:bgColor function:aFunction.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2888
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2889
    self foreground:oldFg background:oldBg function:oldFun
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2890
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2891
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2892
withForeground:fgColor background:bgColor mask:aMask do:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2893
    "evaluate aBlock with foreground, background and mask"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2894
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2895
    |oldFg oldBg oldMask|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2896
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2897
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2898
    oldBg := background.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2899
    oldMask := mask.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2900
    self foreground:fgColor background:bgColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2901
    self mask:aMask.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2902
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2903
    self foreground:oldFg background:oldBg.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2904
    self mask:oldMask
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2905
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2906
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2907
withForeground:fgColor do:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2908
    "evaluate aBlock with changed foreground."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2909
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2910
    |oldFg|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2911
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2912
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2913
    self foreground:fgColor.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2914
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2915
    self foreground:oldFg
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2916
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2917
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2918
withForeground:fgColor function:aFunction do:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2919
    "evaluate aBlock with changed foreground and function."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2920
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2921
    |oldFg oldFun|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2922
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2923
    oldFg := foreground.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2924
    oldFun := function.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2925
    self foreground:fgColor background:background function:aFunction.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2926
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2927
    self foreground:oldFg background:background function:oldFun
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2928
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2929
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2930
xoring:aBlock
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2931
    "evaluate aBlock with function xoring"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2932
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2933
    |fgPixel bgPixel oldFunction|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2934
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2935
    fgPixel := (Black on:device) colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2936
    bgPixel := (White on:device) colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2937
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2938
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2939
	self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2940
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2941
    oldFunction := function.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2942
    device setForeground:(fgPixel bitXor:bgPixel)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2943
	      background:bgPixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2944
		      in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2945
    device setFunction:#xor in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2946
    aBlock value.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2947
    paint := nil.        "invalidate"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2948
    foreground := Black.   
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2949
    background := White.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2950
    device setForeground:fgPixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2951
	      background:bgPixel
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2952
		      in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2953
    device setFunction:oldFunction in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2954
    function := oldFunction
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2955
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2956
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2957
!DeviceGraphicsContext methodsFor:'filling'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2958
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2959
fillArcX:x y:y width:w height:h from:startAngle angle:angle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2960
    "draw a filled arc; apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2961
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  2962
    |pX pY rpX rpY nW nH|
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2963
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2964
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2965
        self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2966
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2967
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2968
        pX := transformation applyToX:x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2969
        pY := transformation applyToY:y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2970
        nW := transformation applyScaleX:w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2971
        nH := transformation applyScaleY:h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2972
        nW < 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2973
              nW := nW abs.  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2974
              pX := pX - nW.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2975
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2976
        nH < 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2977
              nH := nH abs.  
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2978
              pY := pY - nH.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2979
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2980
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2981
        pX := x.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2982
        pY := y.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2983
        nW := w.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2984
        nH := h.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2985
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2986
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2987
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2988
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2989
    nW := nW rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2990
    nH := nH rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2991
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2992
    device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2993
          fillArcX:pX 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2994
                 y:pY 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2995
             width:nW
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2996
            height:nH 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2997
              from:startAngle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2998
             angle:angle
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2999
                in:drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3000
              with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3001
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3002
"/    rpX := pX rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3003
"/    rpY := pY rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3004
"/    nW := (nW + (rpX - pX)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3005
"/    nH := (nH + (rpY - pY)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3006
"/
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3007
"/    device
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3008
"/          fillArcX:rpX 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3009
"/                 y:rpY 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3010
"/             width:nW
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3011
"/            height:nH 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3012
"/              from:startAngle
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3013
"/             angle:angle
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3014
"/                in:drawableId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3015
"/              with:gcId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3016
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3017
    "Created: 8.5.1996 / 08:29:45 / cg"
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3018
    "Modified: 4.6.1996 / 17:58:21 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3019
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3020
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3021
fillPolygon:aPolygon
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3022
    "draw a filled polygon; apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3023
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3024
    |newPolygon|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3025
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3026
    gcId isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3027
	self initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3028
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3029
    transformation notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3030
	newPolygon := aPolygon collect:[:point | transformation applyTo:point].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3031
    ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3032
	newPolygon := aPolygon
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3033
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3034
    (newPolygon findFirst:[:p | 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3035
	(p isPoint not 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3036
	or:[(p x class ~~ SmallInteger)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3037
	or:[(p y class ~~ SmallInteger)]])
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3038
     ]) ~~ 0 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3039
	newPolygon := newPolygon collect:[:p | p asPoint rounded]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3040
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3041
    device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3042
	fillPolygon:newPolygon
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3043
		 in:drawableId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3044
	       with:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3045
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3046
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3047
fillRectangleX:x y:y width:w height:h
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3048
    "draw a filled rectangle; apply transformation if nonNil"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3049
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3050
    |pX pY rpX rpY nW nH|
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3051
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3052
    gcId isNil ifTrue:[
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3053
        self initGC
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3054
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3055
    transformation notNil ifTrue:[
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3056
        pX := transformation applyToX:x.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3057
        pY := transformation applyToY:y.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3058
        nW := transformation applyScaleX:w.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3059
        nH := transformation applyScaleY:h.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3060
        nW < 0 ifTrue:[
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3061
              nW := nW abs.  
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3062
              pX := pX - nW.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3063
        ].
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3064
        nH < 0 ifTrue:[
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3065
              nH := nH abs.  
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3066
              pY := pY - nH.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3067
        ].
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3068
    ] ifFalse:[
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3069
        pX := x.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3070
        pY := y.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3071
        nW := w.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3072
        nH := h.
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3073
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3074
    pX := pX rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3075
    pY := pY rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3076
    nW := nW rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3077
    nH := nH rounded.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3078
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3079
    device
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3080
        fillRectangleX:pX 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3081
                     y:pY 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3082
                 width:nW 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3083
                height:nH 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3084
                    in:drawableId with:gcId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3085
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3086
"/    rpX := pX rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3087
"/    rpY := pY rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3088
"/    nW := (nW + (pX - rpX)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3089
"/    nH := (nH + (pY - rpY)) rounded.
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3090
"/
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3091
"/    device
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3092
"/        fillRectangleX:rpX 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3093
"/                     y:rpY 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3094
"/                 width:nW 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3095
"/                height:nH 
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3096
"/                    in:drawableId with:gcId
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3097
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3098
    "Modified: 4.6.1996 / 17:58:49 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3099
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3100
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3101
!DeviceGraphicsContext methodsFor:'initialization'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3102
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3103
createGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3104
    "since we do not need a gc-object for the drawable until something is
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3105
     really drawn, none is created.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3106
     This method is sent, when the first drawing happens"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3107
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3108
    |fgId bgId p|
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3109
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3110
    gcId := device gcFor:drawableId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3111
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3112
    foreground isNil ifTrue:[foreground := Black].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3113
    background isNil ifTrue:[background := White].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3114
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3115
    foreground isColor ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3116
        "get device colors from the device indep. colors"
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3117
        foreground := foreground on:device.
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3118
        fgId := foreground colorId.
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3119
        fgId isNil ifTrue:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3120
            (foreground grayIntensity >= 50) ifTrue:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3121
                fgId := device whitepixel
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3122
            ] ifFalse:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3123
                fgId := device blackpixel
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3124
            ]
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3125
        ].
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3126
    ] ifFalse:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3127
        fgId := device blackpixel.
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3128
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3129
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3130
    background isColor ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3131
        background := background on:device.
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3132
        bgId := background colorId.
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3133
        bgId isNil ifTrue:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3134
            (background grayIntensity >= 50) ifTrue:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3135
                bgId := device whitepixel
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3136
            ] ifFalse:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3137
                bgId := device blackpixel
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3138
            ]
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3139
        ].
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3140
    ] ifFalse:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3141
        bgId := device whitepixel
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3142
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3143
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3144
    "now, this is something the device can work with ..."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3145
    device setForeground:fgId background:bgId in:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3146
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3147
    "switch to paint"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3148
    p := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3149
    paint := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3150
    self paint:p.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3151
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3152
    ((lineWidth ~~ 0) 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3153
    or:[(lineStyle ~~ #solid) 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3154
    or:[(capStyle ~~ #butt)
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3155
    or:[joinStyle ~~ #miter]]]) ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3156
        device setLineWidth:lineWidth 
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3157
                      style:lineStyle
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3158
                        cap:capStyle
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3159
                       join:joinStyle
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3160
                         in:gcId
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3161
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3162
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3163
    mask notNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3164
        (mask depth == 1) ifTrue:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3165
            device setBitmapMask:(mask id) in:gcId
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3166
        ] ifFalse:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3167
            device setPixmapMask:(mask id) in:gcId
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3168
        ].
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3169
        maskOrigin notNil ifTrue:[
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3170
            device setMaskOriginX:maskOrigin x y:maskOrigin y in:gcId
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3171
        ]
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3172
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3173
    (function ~~ #copy) ifTrue:[device setFunction:function in:gcId].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3174
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3175
    "defer the getting of a device font 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3176
     - this is now done when the first drawstring occurs,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3177
     since many views (layout-views) will never draw strings and
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3178
     therefore, the overhead of aquiring a font can be avoided.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3179
    "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3180
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3181
"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3182
    font := font on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3183
    id := font fontId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3184
    id notNil ifTrue:[
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3185
        device setFont:id in:gcId
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3186
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3187
"
745
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3188
d4465098f2c0 gray vs. grey
Claus Gittinger <cg@exept.de>
parents: 735
diff changeset
  3189
    "Modified: 28.5.1996 / 20:45:24 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3190
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3191
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3192
destroy
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3193
    "when the drawable is destroyed, the associated GC must be destroyed with it"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3194
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3195
    gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3196
	device destroyGC:gcId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3197
	gcId := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3198
	Lobby registerChange:self.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3199
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3200
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3201
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3202
initGC
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3203
    "since we do not need a gc-object for the drawable until something is
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3204
     really drawn, none is created.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3205
     This method is sent, when the first drawing happens"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3206
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3207
    self createGC.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3208
    Lobby registerChange:self.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3209
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3210
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3211
initialize
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3212
    "setup everything for later use; actual work is done in
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3213
     initColors and initFont, which are usually redefined."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3214
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3215
    "make certain Workstation is initialized - just a check - will vanish soon"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3216
    Display isNil ifTrue:[
950
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3217
        'DEVDRAW: Display not initialized when first DeviceGraphicsContext created' errorPrintNL.
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3218
        Workstation initialize
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3219
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3220
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3221
    super initialize.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3222
950
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3223
    foreground isNil ifTrue:[foreground := Black].
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3224
    background isNil ifTrue:[background := White].
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3225
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3226
    "Modified: 17.7.1996 / 12:59:47 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3227
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3228
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3229
prepareForReinit
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3230
    "kludge - clear drawableId and gcId 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3231
     needed after snapin"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3232
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3233
    gcId := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3234
    drawableId := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3235
    deviceFont := nil
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3236
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3237
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3238
recreate
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3239
    "sent after a snapin, reinit draw stuff for new device"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3240
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3241
    gcId := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3242
    foreground notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3243
	foreground := foreground on:device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3244
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3245
    background notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3246
	background := background on:device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3247
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3248
    paint notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3249
	paint := paint on:device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3250
    ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3251
    bgPaint notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3252
	bgPaint := bgPaint on:device
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3253
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3254
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3255
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3256
reinitialize
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3257
    'reinit of ' errorPrint. self classNameWithArticle errorPrint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3258
    ' failed' errorPrintNL
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3259
!
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3260
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3261
releaseGC
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3262
    "destroy the associated GC - can be done to be nice to the 
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3263
     display if you know that you are done with a drawable."
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3264
844
17d0f74d7d02 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 832
diff changeset
  3265
    foreground := background := paint := bgPaint := nil.
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3266
    gcId notNil ifTrue:[
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3267
        device destroyGC:gcId.
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3268
        gcId := nil.
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3269
        Lobby registerChange:self.
844
17d0f74d7d02 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 832
diff changeset
  3270
    ].
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3271
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3272
    "Created: 11.6.1996 / 22:07:30 / cg"
844
17d0f74d7d02 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 832
diff changeset
  3273
    "Modified: 12.6.1996 / 20:52:34 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3274
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3275
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3276
!DeviceGraphicsContext methodsFor:'instance release'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3277
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3278
disposed
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3279
    "some Drawable has been collected 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3280
     - must release operating system resources"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3281
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3282
    ^ self subclassResponsibility
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3283
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3284
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3285
!DeviceGraphicsContext methodsFor:'private'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3286
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3287
setDevice:aDevice id:aDrawbleId gcId:aGCId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3288
    "private"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3289
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3290
    device := aDevice.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3291
    gcId := aGCId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3292
    drawableId := aDrawbleId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3293
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3294
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3295
setGCForPaint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3296
    "private; given a complex color (i.e. a pixmap or dithered color,
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3297
     setup the GC to draw in this color.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3298
     A helper for paint and paint:on:"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3299
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3300
    |dither map pixelId p fg bg vOrg ditherDepth deviceDepth|
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3301
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3302
    gcId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3303
        (p := paint) isColor ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3304
            paint := p := p on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3305
            pixelId := p colorId.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3306
            pixelId notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3307
                "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3308
                 a real (undithered) color
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3309
                "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3310
                mask notNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3311
                    mask := nil.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3312
                    device setBitmapMask:nil in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3313
                ]. 
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3314
                (p ~~ foreground) ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3315
                    foreground := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3316
                    device setForeground:pixelId in:gcId
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3317
                ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3318
                ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3319
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3320
            "a dithered color"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3321
            dither := paint ditherForm.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3322
        ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3323
            "mhmh - seems to be some kind of form ..."
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3324
            paint := paint on:device.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3325
            dither := paint
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3326
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3327
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3328
         a dithered color or image
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3329
        "
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3330
        (ditherDepth := dither depth) == 1 ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3331
            "a simple 0/1 bitmap"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3332
            map := dither colorMap.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3333
            "temporary (kludgy) fix for destroyed paint"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3334
            p := paint.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3335
            map isNil ifTrue:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3336
                fg := Color black.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3337
                bg := Color white.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3338
            ] ifFalse:[
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3339
                fg := map at:2.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3340
                bg := map at:1.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3341
            ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3342
            self foreground:fg background:bg.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3343
            paint := p
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3344
        ] ifFalse:[
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3345
            deviceDepth := device depth.
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3346
            (ditherDepth ~~ deviceDepth) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3347
                dither := dither asFormOn:device.
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3348
                ditherDepth := dither depth.
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3349
                (dither isNil or:[ditherDepth ~~ deviceDepth]) ifTrue:[
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3350
                    self error:'bad dither'.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3351
                    ^ self
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3352
                ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3353
            ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3354
        ].
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3355
        self mask:dither.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3356
        vOrg := self viewOrigin.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3357
        self setMaskOriginX:vOrg x negated y:vOrg y negated.
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3358
    ]
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3359
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3360
    "Created: 16.5.1996 / 15:35:51 / cg"
832
064890dcfabd fixed opaque string draw with deep-dither
Claus Gittinger <cg@exept.de>
parents: 786
diff changeset
  3361
    "Modified: 12.6.1996 / 12:49:07 / cg"
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3362
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3363
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3364
!DeviceGraphicsContext methodsFor:'queries'!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3365
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3366
horizontalIntegerPixelPerMillimeter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3367
    "return the (rounded) number of pixels per millimeter"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3368
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3369
    ^ device horizontalPixelPerMillimeter rounded
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3370
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3371
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3372
horizontalPixelPerInch
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3373
    "return the number of horizontal pixels per inch of the display"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3374
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3375
    ^ device horizontalPixelPerMillimeter * 25.4
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3376
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3377
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3378
horizontalPixelPerMillimeter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3379
    "return the number of pixels per millimeter (not rounded)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3380
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3381
    ^ device horizontalPixelPerMillimeter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3382
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3383
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3384
horizontalPixelPerMillimeter:millis
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3385
    "return the number of pixels (not rounded) for millis millimeter"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3386
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3387
    ^ device horizontalPixelPerMillimeter * millis
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3388
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3389
784
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3390
resolution
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3391
    "return a point consisting of pixel-per-inch horizontally and vertically."
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3392
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3393
    ^ device resolution
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3394
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3395
    "Created: 4.6.1996 / 15:23:55 / cg"
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3396
!
be774c8a672f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 768
diff changeset
  3397
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3398
verticalIntegerPixelPerMillimeter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3399
    "return the (rounded) number of pixels per millimeter"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3400
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3401
    ^ device verticalPixelPerMillimeter rounded
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3402
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3403
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3404
verticalPixelPerInch
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3405
    "return the number of vertical pixels per inch of the display"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3406
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3407
    ^ device verticalPixelPerMillimeter * 25.4
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3408
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3409
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3410
verticalPixelPerMillimeter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3411
    "return the number of pixels per millimeter (not rounded)"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3412
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3413
    ^ device verticalPixelPerMillimeter
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3414
!
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3415
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3416
verticalPixelPerMillimeter:millis
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3417
    "return the number of pixels (not rounded) for millis millimeter"
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3418
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3419
    ^ device verticalPixelPerMillimeter * millis
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3420
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3421
902
7f5d81d377de opaque image display fix
Claus Gittinger <cg@exept.de>
parents: 895
diff changeset
  3422
!DeviceGraphicsContext  class methodsFor:'documentation'!
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3423
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3424
version
950
d4d907fc7d78 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 927
diff changeset
  3425
    ^ '$Header: /cvs/stx/stx/libview/DeviceGraphicsContext.st,v 1.13 1996-07-17 12:17:17 cg Exp $'
732
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3426
! !
af737b0a3a37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  3427
DeviceGraphicsContext initialize!