"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

Object subclass:#GraphicsMedium

	instanceVariableNames:'device gc width height realized'

	classVariableNames:''

	poolDictionaries:''

	category:'Graphics-Support'

!

!GraphicsMedium class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    this is an abstract superclass for all kinds of drawables which

    have a physical representation (i.e. have an extent). Dont use messages

    from here - it will vanish soon.

    [Instance variables:]

	width           <SmallInteger>  the width (device dependent, usually pixels or inches)

	height          <SmallInteger>  the height (device dependent, usually pixels or inches)

    [author:]

	Claus Gittinger

"

! !

!GraphicsMedium class methodsFor:'instance creation'!

new

    "create a new drawable - take the current display as

     its device (for now, this may be changed until the view is

     physically created)"

"

    'Warning: DeviceGraphicsContext (' print. self name print. ') should not be created with new' printNL.

"

    ^ self onDevice:Screen current.

!

on:aDevice

    "create a new drawable on aDevice"

    <resource:#obsolete>

    "/ send out a warning: #on: is typically used to create a view

    "/ operating on a model.

    "/ Please use #onDevice: to avoid confusion.

    self obsoleteMethodWarning:'use #onDevice:'.

    ^ self onDevice:aDevice

    "Modified: 5.6.1997 / 21:04:16 / cg"

!

onDevice:aDevice

    "create a new drawable on aDevice"

    ^ self basicNew initializeForDevice:aDevice.

! !

!GraphicsMedium class methodsFor:'Signal constants'!

drawingOnClosedDrawableSignal

    "return the signal which is raised, if drawing is attempted

     on a closed drawable.

     This is especially useful, if a forked thread animates

     a view in the background, and is not properly synchronized

     with the window thread - i.e. the window gets closed by the user,

     and the background process continues to draw.

     In this case, the background thread should handle this signal

     and terminate itself in the handler."

    ^ GraphicsContext drawingOnClosedDrawableSignal

    "demonstration1: (error if closed by the windowManager):

     |v|

     v := StandardSystemView new openAndWait.

     [

	[true] whileTrue:[

	    |x y|

	    x := Random nextIntegerBetween:0 and:(v width).

	    y := Random nextIntegerBetween:0 and:(v height).

	    v displayString:'hello' x:x y:y.

	    Delay waitForSeconds:0.5.

	]

     ] fork.

    "

    "demonstration2: (no error if closed by the windowManager):

     |v|

     v := StandardSystemView new openAndWait.

     [

	v class drawingOnClosedDrawableSignal handle:[:ex |

	    ex return

	] do:[

	    [true] whileTrue:[

		|x y|

		x := Random nextIntegerBetween:0 and:(v width).

		y := Random nextIntegerBetween:0 and:(v height).

		v displayString:'hello' x:x y:y.

		Delay waitForSeconds:0.5.

	    ]

	]

     ] fork.

    "

    "Created: / 29.1.1998 / 13:10:41 / cg"

    "Modified: / 29.1.1998 / 13:11:14 / cg"

! !

!GraphicsMedium class methodsFor:'accessing-defaults'!

defaultFont

    "get the default font used for drawing"

    ^ GraphicsContext defaultFont

!

defaultFont:aFont

    "set the default font used for drawing"

    GraphicsContext defaultFont:aFont

! !

!GraphicsMedium methodsFor:'Compatibility-ST80'!

displayArc:origin radius:radius from:startAngle angle:angle

    "draw an arc around a point"

    self

	displayArcX:(origin x - radius)

		  y:(origin y - radius)

	      width:(radius * 2)

	     height:(radius * 2)

	       from:startAngle

	      angle:angle

    "Modified: 8.5.1996 / 08:34:43 / cg"

!

displayArcBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle

   "draw an arc/circle/ellipse - ST-80 compatibility"

   ^ self displayArcX:(boundingBox left)

		    y:(boundingBox top)

		width:(boundingBox width)

	       height:(boundingBox height)

		 from:startAngle

		angle:sweepAngle

    "Created: / 14.11.1997 / 21:04:19 / cg"

!

displayArcBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle at:origin

   "draw an arc/circle/ellipse - ST-80 compatibility"

   ^ self displayArcX:(boundingBox left + origin x)

		    y:(boundingBox top + origin y)

		width:(boundingBox width)

	       height:(boundingBox height)

		 from:startAngle

		angle:sweepAngle

!

displayLineFrom:startPoint to:endPoint translateBy:anOffset

    "draw a line - ST-80 compatibility"

    self displayLineFrom:(startPoint + anOffset)

		      to:(endPoint + anOffset)

!

displayPolyline:aPolygon

    "draw a polygon - ST-80 compatibility"

    ^ self displayPolygon:aPolygon

!

displayRectangularBorder:aRectangle

    "draw a rectangle - ST-80 compatibility"

    self displayRectangle:aRectangle

!

displayRectangularBorder:aRectangle at:aPoint

    "draw a rectangle - ST-80 compatibility"

    self displayRectangle:(aRectangle translateBy:aPoint)

!

displayWedgeBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle

   "fill an arc/circle/ellipse - ST-80 compatibility"

   ^ self fillArcX:(boundingBox left)

		 y:(boundingBox top)

	     width:(boundingBox width)

	    height:(boundingBox height)

	      from:startAngle

	     angle:sweepAngle

    "Created: 27.1.1997 / 15:50:14 / cg"

!

displayWedgeBoundedBy:boundingBox startAngle:startAngle sweepAngle:sweepAngle at:origin

   "fill an arc/circle/ellipse - ST-80 compatibility"

   ^ self fillArcX:(boundingBox left + origin x)

		 y:(boundingBox top + origin y)

	     width:(boundingBox width)

	    height:(boundingBox height)

	      from:startAngle

	     angle:sweepAngle

!

findFont:aFontDescription

    "given a fontDescription, return a device font for it

     on my device."

    ^ aFontDescription onDevice:self device

    "Modified: 28.5.1996 / 20:22:29 / cg"

!

key

    ^ self drawableId

!

phase

    "return the origin within the mask (used to draw with patterns).

     This is an alias for ST/X's #maskOrigin"

    ^ self maskOrigin

!

phase:aPoint

    "set the origin within the mask (used to draw with patterns).

     This is an alias for ST/X's #maskOrigin:"

    ^ self maskOrigin:aPoint

!

setDevicePattern:aColorOrMask

    "ST/X can paint in any color or image"

    self paint:aColorOrMask

!

tilePhase

    "return the origin within the mask (used to draw with patterns).

     This is an alias for ST/X's #maskOrigin"

    ^ self maskOrigin

    "Created: 4.6.1996 / 15:26:39 / cg"

!

tilePhase:aPoint

    "set the origin within the mask (used to draw with patterns).

     This is an alias for ST/X's #maskOrigin"

    ^ self maskOrigin:aPoint

    "Created: 4.6.1996 / 15:26:49 / cg"

!

widthOfString:aString

    "given a string, return its width in pixels if

     drawn on the receivers device."

    ^ gc widthOfString:aString.

    "Modified: 28.5.1996 / 20:22:22 / cg"

!

widthOfString:aString from:start to:stop

    "given a string, return the width in pixels if

     a substring is drawn on the receivers device."

    ^ gc widthOfString:aString from:start to:stop.

    "Modified: 28.5.1996 / 20:22:18 / cg"

! !

!GraphicsMedium methodsFor:'Compatibility-Squeak'!

copyBits:aRectangle from:aForm at:srcOrigin clippingBox:clippingBox rule:rule fillColor:fillColor

    |f oldClip oldFunction|

    (f := rule) isInteger ifTrue:[

        "/ ST-80 compatibility: numeric rule

        f := #(clear and andReverse  copy andInverted noop xor or nor equiv invert orInverted copyInverted

               orReverse nand set) at:(rule + 1).

    ].

    oldFunction := gc function.

    oldClip := gc clippingBoundsOrNil.

    gc clippingBounds:clippingBox.

    gc function:f.

    gc

        copyFrom:aForm

        x:srcOrigin x y:srcOrigin y

        toX:aRectangle left y:aRectangle top

        width:aRectangle width height:aRectangle height.

    gc clippingBounds:oldClip.

    gc function:oldFunction.

    "

      |dst src|

      dst := Form width:8 height:8 fromArray:#[

                                              2r00000000

                                              2r00000000

                                              2r00000000

                                              2r00000000

                                              2r11111111

                                              2r11111111

                                              2r11111111

                                              2r11111111

                                             ].

      src := Form width:8 height:8 fromArray:#[

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                             ].

    dst copyBits:(0@0 corner:8@8) from:src at:0@0 clippingBox:(0@0 corner:8@8) rule:15 fillColor:Color black.

    dst inspect

    "

    "Modified: / 23.10.2000 / 16:50:44 / martin"

    "

      |dst src|

      dst := Form width:8 height:8 fromArray:#[

                                              2r00000000

                                              2r00000000

                                              2r00000000

                                              2r00000000

                                              2r11111111

                                              2r11111111

                                              2r11111111

                                              2r11111111

                                             ].

      src := Form width:8 height:8 fromArray:#[

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                              2r00001111

                                             ].

    dst copyBits:(0@0 corner:8@8) from:src at:0@0 clippingBox:(0@0 corner:8@8) rule:15 fillColor:Color black.

    dst inspect

    "

    "Modified: / 23.10.2000 / 16:50:44 / martin"

!

fill:aRectangle fillColor:aColor

    "fill the rectangular area specified by aRectangle with the black color"

    gc fill:aRectangle fillColor:aColor

!

fillBlack:aRectangle

    "fill the rectangular area specified by aRectangle with the black color"

    self fill:aRectangle fillColor:self blackColor

!

fillColor:something

    "fill the receiver with something;

     something may be a Form, Color or colorIndex"

    self fill:something

!

fillRectangle:aRectangle color:aColor

    "fill a rectangle with the given paint color"

    gc fillRectangle:aRectangle color:aColor

!

fillWhite

    "fill all of the receiver with the white color"

    self fill:self whiteColor

!

fillWhite:aRectangle

    "fill the rectangular area specified by aRectangle with the white color"

    self fill:aRectangle fillColor:self whiteColor

! !

!GraphicsMedium methodsFor:'Compatibility-VW'!

displayBackgroundIfNeededOn: aGraphicsContext

    aGraphicsContext clearView.

!

inactiveForegroundColor

    "a dummy method to support VW widgets"

    ^ self foregroundColor

!

selectionBackgroundColor

    "a dummy method to support VW widgets"

    ^ self foregroundColor

!

selectionForegroundColor

    "a dummy method to support VW widgets"

    ^ self backgroundColor

!

separatorColor

    "a dummy method to support VW widgets"

    ^ self foregroundColor

! !

!GraphicsMedium methodsFor:'accessing'!

at:aPoint

    "return the pixel at the coordinate given by aPoint"

    ^ self atX:aPoint x y:aPoint y

    "Modified: / 29.1.2000 / 12:17:42 / cg"

!

at:aPoint put:aPixelColor

    "set a pixel"

    ^ self atX:aPoint x y:aPoint y put:aPixelColor

    "

     Display rootView at:(0@0) put:(Color red).

     Display rootView at:(1@1) put:(Color red).

     Display rootView at:(2@2) put:(Color red).

     Display rootView at:(3@3) put:(Color red).

     Display rootView at:(4@4) put:(Color red).

     Display rootView at:(5@5) put:(Color red).