'From Squeak3.6gamma of ''11 September 2003'' [latest update: #5420] on 24 March 2004 at 9:50:19 am'!
"Change Set:		RFB
Date:			ikp 3/8/2004 04:33
Author:			Ian Piumarta

This is a remote framebuffer (RFB, aka 'VNC') server written entirely in Squeak.  It implements the version 3.7 protocol as defined by RealVNC.com, plus numerous extensions that are useful with the popular 'TightVNC' viewer.  See the class comment in RFBServer for instructions and important information regarding viewer options and performance.  For the terminally impatient, just evaluate: RFBServer open"!

Object subclass: #RFB3DES
	instanceVariableNames: 'knl knr kn3 '
	classVariableNames: 'BigByte ByteBit PC1 PC2 SP1 SP2 SP3 SP4 SP5 SP6 SP7 SP8 TotRot '
	poolDictionaries: ''
	category: 'RFB-Crypto-3DES'!

!RFB3DES commentStamp: 'ikp 3/8/2004 04:36' prior: 0!
I am a (somewhat trimmed-down) 3DES encryption algorithm intended only for use in VNC password authentication.  My reason for existing is to avoid an otherwise very nasty dependency on the DESPlugin (which would provided suitable functionality, but which is not normally bundled with Squeak VMs).

I'm not particularly fast (you wouldn't want to ask me to encrypt a megabyte of data) but, since I'm only here to encrypt 16-byte authentication challenges during the connection handshake, who cares?!

BitBlt subclass: #RFBBitBlt
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBBitBlt commentStamp: 'ikp 3/5/2004 14:05' prior: 0!
I am a regular BitBlt with slightly modified behaviour:

	- I provide instance creation methods that work for 8-bit Forms that are RGB (rather than indexed, a rather gross assumption on the part of BitBlt)
	- I support filling areas with pixel values (rather than Colors)
	- I provide some additional accessing methods (to eliminate a few message sends here and there)
	- I take care to unhibernate my destForm correctly after snapshot (avoiding a nasty bug that affects cached "bit peekers")!

ImageMorph subclass: #RFBClient
	instanceVariableNames: 'scrollPane window socket sendLock state process protocolMinor serverExtent serverFormat serverName updateRequestPending currentCursor savedCursor hasCursor modifierState zlibStream '
	classVariableNames: 'CommandKeySym CtrlKeySym DefaultEncoding Enable8Bit EnableExpandOnBell EnableExpandOnConnection EnableShared EnableViewOnly EnableXCursor Encodings FastUpdate KeySyms MessageTypes ModifierMap OptionKeySym ProtocolMajor ProtocolMinor RfbEncodingAuto RfbEncodingCoRRE RfbEncodingCopyRect RfbEncodingHextile RfbEncodingLastRect RfbEncodingPointerPos RfbEncodingRRE RfbEncodingRaw RfbEncodingRichCursor RfbEncodingTight RfbEncodingXCursor RfbEncodingZRLE RfbEncodingZlib RfbEncodingZlibHex ShiftKeySym WindowLabel '
	poolDictionaries: 'EventSensorConstants '
	category: 'RFB-Viewer'!

!RFBClient commentStamp: 'ikp 3/23/2004 12:03' prior: 0!
I am a RFB/VNC viewer.  If you send me #open then I will open a window with a menu (on the scrollbar button) for connecting to a remote RFB/VNC server.!

DisplayScreen subclass: #RFBDisplayScreen
	instanceVariableNames: 'rfbServer colourMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBDisplayScreen commentStamp: 'ikp 3/5/2004 14:16' prior: 0!
I am a kind of DisplayScreen that also forwards screen updates and beep requests to the active RFBServer.  I replace the usual Display whenever a RFBServer is running, and remove myself gracefully whenever the RFBServer is shut down.!

EventSensor subclass: #RFBEventSensor
	instanceVariableNames: 'rfbServer eventMutex '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBEventSensor commentStamp: 'ikp 3/5/2004 14:16' prior: 0!
I am a kind of EventSensor that forwards mouse events and cursor change requests to the active RFBServer.  I replace the regular Sensor whenever the RFBServer is running (and remove myself whenever the RFBServer is shut down).!

Form subclass: #RFBForm
	instanceVariableNames: 'format fill '
	classVariableNames: 'IdentityMap16 NumLargeInts NumSmallInts RfbHextileAnySubrects RfbHextileBackgroundSpecified RfbHextileForegroundSpecified RfbHextileRaw RfbHextileSubrectsColoured RfbZrleBitsPerPackedPixel RfbZrleTileHeight RfbZrleTileWidth '
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBForm commentStamp: 'ikp 3/24/2004 00:17' prior: 0!
I am a kind of Form that provides several additional facilities:

	- I hold on to cached BitBlts for doing pixel-based access (peeking, poking and filling), and provide additional methods #pixelAt:, #pixelAt:put:, and #pixelsIn:put: that use them.
	- I can describe my pixel format (depth, byte order, etc.) in the way that an RFBServer finds most useful.
	- I provide several methods to support the encoding of my contents on a stream for sending to a remote RFB viewer.!

RFBForm subclass: #OldRFBDamageRecorder
	instanceVariableNames: 'cachedForm deltaForm deltaBlt depthBlt foldBlt updateBlt clearBlt '
	classVariableNames: 'DamageHeight DamageWidth '
	poolDictionaries: ''
	category: 'RFB-Server'!

!OldRFBDamageRecorder commentStamp: 'ikp 3/4/2004 04:04' prior: 0!
| r |
r _ RFBDamageRecorder forDisplay.
Time millisecondsToRun: [
10000 timesRepeat: [
r testDamage: Display in: (96@96 extent: 32@32)
]]
 1241

Time millisecondsToRun: [
10000 timesRepeat: [
Display isChangedFrom3b: Display in: (96@96 extent: 32@32).
]] 
 1333


| f d l t n |
n _ 128.
f _ RFBForm fromDisplay: Display boundingBox.
d _ RFBDamageRecorder forForm: f.
f fill: (200@200 corner: 600@600) fillColor: Color red.
l _ OrderedCollection new.
MessageTally spyOn: [t _ Time millisecondsToRun: [
0 to: f height - n by: n do: [:y | 0 to: f width - n by: n do: [:x |
	(d testDamage: f in: (x@y extent: n@n))
		ifTrue: [l add: x@y]]].
]].
^Array with: t with: l



| f d l |
f _ RFBForm fromDisplay: (0@0 extent: 64@64).
d _ RFBDamageRecorder forForm: f.
"
MessageTally spyOn: [
"
0 to: 20 do: [:yy | Smalltalk beepPrimitive.
0 to: 20 do: [:xx |
1 to: 8 do: [:n | 
	f fill: (xx@yy extent: 1@1) fillColor: (Color r: yy / 40.0 g: xx / 40.0 b: n / 8.0).
	l _ OrderedCollection new.
	0 to: f height - n by: n do: [:y | 0 to: f width - n by: n do: [:x |
	(d testDamage: f in: (x@y extent: n@n))
		ifTrue: [l add: x@y]]].
	l size ~= 1 ifTrue: [self error: 'oops']]]].
"
]
"!

RFBForm subclass: #RFBClientForm
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Viewer'!

!RFBClientForm commentStamp: 'ikp 3/23/2004 12:04' prior: 0!
I am a RFBForm that understands how to decode framebuffer update messages.!

RFBForm subclass: #RFBDamageRecorder
	instanceVariableNames: 'targetForm '
	classVariableNames: 'DamageHeight DamageWidth '
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBDamageRecorder commentStamp: 'ikp 3/5/2004 14:09' prior: 0!
I am a Form that record damaged areas relative to another Form.  After instantiating me with "on: originalForm" you can ask me at any time "isDamaged" or "isDamagedIn: boundingRectangle" and I will answer true or false, depending on whether originalForm has changed in the given bounds since the last time you asked.!

RFBDamageRecorder subclass: #RFBDamageFilter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBDamageFilter commentStamp: 'ikp 3/5/2004 14:12' prior: 0!
I am a kind of RFBDamageRecorder that understands damaged regions (consisting of Collections of Rectangles) instead of just a simple bounding Rectangle.  You instantiate me just like a RFBDamageRecorder, and can then ask me to "getDamageInRegion: rectangleCollection".  I will answer with another Collection containing only rectangles that really were modified since the last time you asked, and which have been trimmed as necessary to guarantee that no "false" damage is reported more than 32 pixels away from "real" damage.!

DumberMenuMorph subclass: #RFBMenuMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBMenuMorph commentStamp: 'ikp 3/24/2004 00:17' prior: 0!
I am a MenuMorph that knows how to retrieve update information from blocks in addition to the usual "target + selector" mechanism.!

ByteArray variableByteSubclass: #RFBMessage
	instanceVariableNames: ''
	classVariableNames: 'RfbBell RfbClientCutText RfbConnFailed RfbFixColourMapEntries RfbFramebufferUpdate RfbFramebufferUpdateRequest RfbKeyEvent RfbNoAuth RfbPointerEvent RfbServerCutText RfbSetColourMapEntries RfbSetEncodings RfbSetPixelFormat RfbVncAuth RfbVncAuthFailed RfbVncAuthOK RfbVncAuthTooMany '
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBMessage commentStamp: 'ikp 3/5/2004 14:45' prior: 0!
We (myself and my subclasses) represent a message sent to, or received from, a remote RFB viewer.  We implement accessing protocol that makes it easy to read and write the fields within messages, but we are also a kind of ByteArray (which makes it east to read and write us over a network connection).!

RFBMessage variableByteSubclass: #RFBBell
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBBell commentStamp: 'ikp 3/5/2004 14:46' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBClientCutText
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBClientCutText commentStamp: 'ikp 3/5/2004 14:46' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBCoRRERectangle
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBCoRRERectangle commentStamp: 'ikp 3/5/2004 14:51' prior: 0!
I am a fragment of a RFBMessage representing an update rectangle in the CoRRE encoding.!

RFBMessage variableByteSubclass: #RFBFixColourMapEntries
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBFixColourMapEntries commentStamp: 'ikp 3/5/2004 14:46' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBFramebufferUpdate
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBFramebufferUpdate commentStamp: 'ikp 3/5/2004 14:47' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBFramebufferUpdateRectHeader
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBFramebufferUpdateRectHeader commentStamp: 'ikp 3/5/2004 14:51' prior: 0!
I am a fragment of a RFBMessage representing a "generic" screen update rectangle.!

RFBMessage variableByteSubclass: #RFBFramebufferUpdateRequest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBFramebufferUpdateRequest commentStamp: 'ikp 3/5/2004 14:47' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBKeyEvent
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBKeyEvent commentStamp: 'ikp 3/5/2004 14:47' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

Object subclass: #RFBPalette
	instanceVariableNames: 'index key pixels size '
	classVariableNames: 'RfbPaletteMaxSize '
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBPalette commentStamp: 'ikp 3/24/2004 00:17' prior: 0!
I am a colour palette.  I manage some number of pixel values (see #insert:) which I convert into an indexed palette (see #lookup:).  I am used by the ZRLE encoding which tries to send indexed pixel values instead of raw pixel values whenever possible.!

Object subclass: #RFBPixelFormat
	instanceVariableNames: 'bitsPerPixel depth bigEndian trueColour redMax greenMax blueMax redShift greenShift blueShift orderMap colourMap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBPixelFormat commentStamp: 'ikp 3/5/2004 14:22' prior: 0!
I describe the pixel format being used by a remote RFB viewer, including:

	- the byte order (big or little endian)
	- whether pixels are RGB (true colour) or indices into a colour lookup table (pseudo colour)
	- for true colour, I also remember the shifts and masks that describe each of the three colour channels (R, G and B) in a pixel.!

Bag subclass: #RFBPixelPopulation
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBPixelPopulation commentStamp: 'ikp 3/5/2004 14:23' prior: 0!
I am a kind of Bag that interprets its contents as a map of pixelValue -> pixelCount.!

RFBMessage variableByteSubclass: #RFBPointerEvent
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBPointerEvent commentStamp: 'ikp 3/5/2004 14:47' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBRREHeader
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBRREHeader commentStamp: 'ikp 3/5/2004 14:51' prior: 0!
I am a fragment of a RFBMessage representing an update in the RRE encoding.!

RFBMessage variableByteSubclass: #RFBRectangle
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBRectangle commentStamp: 'ikp 3/5/2004 14:52' prior: 0!
I am a fragment of a RFBMessage representing a "generic" rectangle.!

SharedQueue subclass: #RFBRegion
	instanceVariableNames: 'rectangles lock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Server'!

!RFBRegion commentStamp: 'ikp 3/5/2004 14:25' prior: 0!
I represent a (possibly non-contiguous) damaged region in some display medium (such as a Form).  You send me "add: aRectangle" to add new areas to the region I represent.  Later you can send me "removeFirst" to retrieve individual areas in the region, or "removeAll" to retrieve a Collection of all the rectangles in the region.!

TwoWayScrollPane subclass: #RFBScrollPane
	instanceVariableNames: 'rfbClient '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Viewer'!

!RFBScrollPane commentStamp: 'ikp 3/23/2004 12:05' prior: 0!
I an a TwoWayScrollPane optimised for use with a RFBClient.!

Object subclass: #RFBServer
	instanceVariableNames: 'socket sessions sessionsSema process port localHostName localHostAddress loopbackAddress '
	classVariableNames: 'AllowEmptyPasswords AllowInputEvents AllowLocalConnections AllowRemoteConnections AllowZRLE ConnectionPriority ConserveMemory EnableDamageFilter EnableDebugging EnableLogging EnableMemoryLog EnableRawFilter FixedKey LoopbackAddress LowWaterMark Server ServerLog ServerPreferences ServerProcess VNCPasswords '
	poolDictionaries: 'RFBConstants '
	category: 'RFB-Server'!

!RFBServer commentStamp: 'ikp 3/19/2004 04:05' prior: 0!
I provide interaction with the Squeak display for remote "viewers" using the RFB (Remote Frame Buffer, sometimes also called "VNC" for Virtual Network Computing) protocol developped (initially) by AT&T and (later) by RealVNC.

The easiest way to configure and control me is to open my menu:

	RFBServer open

(which you can pin to the desktop if you like).  You can also send me messages to perform various configuration/control tasks.  The most important of these is:

	RFBServer setFullPassword

which sets a password that remote users must provide in order to connect.  Once you have installed a password you can send me:

	RFBServer start				-- to enable connections from remote viewers
	RFBServer stop				-- to disable them again.

RFB/VNC experts can also send me:

	RFBServer start: displayNumber

(If you don't know the relevance of "displayNumber" then either don't worry about it, or see the documentation that came with your viewer application for an explanation.)

** PERFORMANCE HINTS

If you are running Squeak and the viewer on the same machine (which might happen if you start the image "headless" and suddenly need to interact with it), or if there is a fast connection (100Mbps or better) between you and Squeak, then always use "raw" encoding.  (If you're running a non-headless Unix Squeak remotely over a 100Mbps connection then you shouldn't be using RFB/VNC at all: use X11 instead.)

When using any encoding other than "raw", avoid running the (native) Squeak display at depth 32; use 8 or 16 instead.  This permits various optimisations using BitBlt that significantly decrease the computation needed to analyse the contents of large screen areas.  Although this won't (generally) affect the speed at which remote viewers receive screen updates, it will reduce the load on your running image and free up the processor for doing useful stuff instead.

Avoid "RRE" encoding if you can.  This encoding must analyse the entire update area before sending anything to the viewer.  The result is a long pause (while analysing the update area) followed by saturation of the connection while the entire area is sent at once.  Two time-consuming activities that are strictly sequential when using "RRE".  Conversely, "Hextile" and "CoRRE" split the update area into subrectangles and send each one independently.  This is better for two reasons.  Firstly, it introduces parallelism by overlapping the communication and computation.  Secondly, it's psychologically (much) less stressful on you, since the viewer will update the window contents incrementally -- giving you something to watch while waiting for a large update to complete.  (Note that some viewers deliberately increase your stress level by deferring all graphical output while receiving the initial framebuffer contents.  Ho hum.)

If you are on a slow connection then (obviously) avoid leaving anything on your desktop that 'moves' (a ClockMorph, the Squeak logo with the roving eyes, etc...).

In general:  When running locally, always use "Raw" encoding at any bit depth.  When running remotely, over a medium or slow speed connection, always use "Hextile" encoding at depth 8 or 16, unless you have a good reason not to.

If you have a really hopeless connection (e.g., a very slow modem) consider using "ZRLE" (if your viewer supports it).  This behaves somewhat like Hextile but also "zip" compresses the data before sending it.  Needless to say, ZRLE is extremely CPU-intensive at the server (Squeak) end.

** AESTHETIC HINTS

If you are using the TightVNC viewer then always enable the 'x11cursor' extension.  This (greatly) improves the behaviour of the cursor (it should be identical to the behaviour you'd see if running Squeak locally), eliminates the annoying dot that normally tracks your local cursor position, and decreases (slightly) the bandwidth used.

If you want to use 8-bit colour in the viewer then either:

	- Run Squeak in 8-bit depth and enable 'own colourmap' in the viewer.  Depending on your window system, this may introduce unpleasant artefacts when the pointer enters/leaves the viewer window.

	- Run Squeak in 16-bit depth and use the 'bgr223' pixel format in the viewer.  This provides the most accurate mapping of Squeak colours into the standard 8-bit 'true'-colour pallette of the viewer.  (The results are better than you might expect.)

** CAVEATS

While I am running (between sending me #start and #stop) I replace the Display and Sensor objects with something (almost but not quite entirely) equivalent.  When I am not running I do not leave any trace of my existence behind.

Active sessions to remote viewers involve several inter-communicating processes running at higher than user priority.  In the unlikely event that you hit the interrupt key while one of these processes is in a critical region, quitting the resulting debugger will effectively freeze the remote session.

RealVNC (and many other) viewers do not support the "X11Cursor" extension, which was introduced by TightVNC.

TightVNC (and many other) viewers do not support "ZRLE" encoding, which was introduced by RealVNC.

** BUGS

Screen updates correspond faithfully to the "damaged regions" maintained by Morphic.  This often results in undamaged parts of the display being updated unnecessarily.  This isn't too bad when running locally (you probably won't even notice it most of the time), but can be disasterous when viewing remotely over a slow connection.  The correct solution would be to fix Morphic so that damaged regions accurately reflect the parts of the Display that have been modified (and not simply repainted with the same content) -- so that local screen updates benefit too.  The pragmatic solution (adopted here) is to filter the damage reported by Morphic to eliminate the bogus regions.  (The classes RFBDamageRecorder and RFBDamageFilter take care of the unpleasant details.)!

RFBMessage variableByteSubclass: #RFBServerInitialisation
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBServerInitialisation commentStamp: 'ikp 3/23/2004 12:05' prior: 0!
I am a RFBMessage representing a server initialisation message.!

Object subclass: #RFBSession
	instanceVariableNames: 'server socket process state protocolMinor interactive reverseConnection readyForSetColourMapEntries preferredEncoding sendRect countRects correMaxWidth correMaxHeight authChallenge modifiedRegion requestedRegion format zlibCompressLevel zlibStream enableLastRectEncoding enableCursorShapeUpdates enableCursorPosUpdates useRichCursorEncoding modifiers updateProcess updateSemaphore currentCursor clientCursor mousePosition clientPosition fixColourMapEntries framebufferUpdateRequest framebufferUpdate updateRectHeader keyEvent pointerEvent clientCutText rreHeader zrleHeader xCursorColoursHeader rfbStream damageFilter incremental allocationCount bytesLeft updateCount lowWaterMark highWaterMark meanSeaLevel updateTime totalTime '
	classVariableNames: 'Encodings KeyCodesFF Logging MessageTypes ModifierMap ProtocolMajor ProtocolMinor ProtocolVersion RfbEncodingCoRRE RfbEncodingCopyRect RfbEncodingHextile RfbEncodingLastRect RfbEncodingPointerPos RfbEncodingRRE RfbEncodingRaw RfbEncodingRichCursor RfbEncodingTight RfbEncodingXCursor RfbEncodingZRLE RfbEncodingZlib RfbEncodingZlibHex SecurityTypeNone SecurityTypeVNC SpecialEncodings UseLastRect '
	poolDictionaries: 'EventSensorConstants '
	category: 'RFB-Server'!

!RFBSession commentStamp: 'ikp 3/19/2004 10:37' prior: 0!
I am an active RFB session between a remote viewer and this image.  I implement the full version 3.7 RFB protocol (which is the most recent specification published by RealVNC.com), as well as some of the extensions defined by the popular 'TightVNC' viewer.

You should not instantiate me directly.  See the class comment in RFBServer for further details.
!

RFBMessage variableByteSubclass: #RFBSetEncodings
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBSetEncodings commentStamp: 'ikp 3/5/2004 14:47' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

RFBMessage variableByteSubclass: #RFBSetPixelFormat
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBSetPixelFormat commentStamp: 'ikp 3/5/2004 14:47' prior: 0!
I am a kind of RFBMessage.  See the comment in that class for more information.!

Socket subclass: #RFBSocket
	instanceVariableNames: 'hostName '
	classVariableNames: 'LastServerAddress MaximumTransmissionUnit RFBSocketInstances RfbListenPortOffset RfbPortOffset SendTimeout ServerPortOffset ViewerPortOffset '
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBSocket commentStamp: 'ikp 3/5/2004 14:39' prior: 0!
I am a kind of Socket that understands how to transmit word objects and the originalContents of a Stream.!

RFBSocket subclass: #RFBClientSocket
	instanceVariableNames: 'getPixel getCPixel pixelBuffer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Viewer'!

!RFBClientSocket commentStamp: 'ikp 3/23/2004 12:05' prior: 0!
I am a RFBSocket that understands how to read pixels.!

WriteStream subclass: #RFBStream
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStream commentStamp: 'ikp 3/5/2004 14:43' prior: 0!
I am a kind of Stream over a ByteArray.  I understand both #nextPut: (to append bytes to my contents) and #nextPutPixel: (to append 8-, 16- or 32-bit pixel data, possibly byte-swapped, according to a "pixel format" specified when you instantiate me).  I cooperate with RFBSocket to send my contents over a network connection with "zero copy".

You instantiate me by sending "forDepth: bitsPerPixel byteSwapped: swapFlag".  If bitsPerPixel is 8 then you get back an instance of me.  If bitsPerPixel is not 8 then you get back an instance of one of my four subclasses that deal with 16- and 32-bit pixels in native or byte-swapped order.!

RFBStream subclass: #RFBStream16
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStream16 commentStamp: 'ikp 3/7/2004 20:07' prior: 0!
I am a kind of RFBStream for writing 16-bit pixel data.  See the comment in that class for more information.!

RFBStream subclass: #RFBStream32
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStream32 commentStamp: 'ikp 3/7/2004 20:07' prior: 0!
I am a kind of RFBStream for writing 32-bit pixel data.  See the comment in that class for more information.!

RFBStream32 subclass: #RFBStream24
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStream24 commentStamp: 'ikp 3/18/2004 03:18' prior: 0!
I am a kind of RFBStream for writing 32-bit pixel data or 24-bit 'compressed' pixel data for ZRLE encoding.  See the comment in that class for more information.!

RFBStream subclass: #RFBStreamSwap16
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStreamSwap16 commentStamp: 'ikp 3/7/2004 20:08' prior: 0!
I am a kind of RFBStream for writing byte-swapped 16-bit pixel data.  See the comment in that class for more information.!

RFBStream subclass: #RFBStreamSwap32
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStreamSwap32 commentStamp: 'ikp 3/7/2004 20:08' prior: 0!
I am a kind of RFBStream for writing byte-swapped 32-bit pixel data.  See the comment in that class for more information.!

RFBStreamSwap32 subclass: #RFBStreamSwap24
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBStreamSwap24 commentStamp: 'ikp 3/18/2004 03:18' prior: 0!
I am a kind of RFBStream for writing byte-swapped 32-bit pixel data or 24-bit 'compressed' pixel data for ZRLE encoding.  See the comment in that class for more information.!

SystemWindow subclass: #RFBSystemWindow
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Viewer'!

!RFBSystemWindow commentStamp: 'ikp 3/23/2004 12:06' prior: 0!
I am a SystemWindow with additional support for working with RFBClients.!

RFBMessage variableByteSubclass: #RFBXCursorColoursHeader
	instanceVariableNames: ''
	classVariableNames: 'StandardCursorColours '
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBXCursorColoursHeader commentStamp: 'ikp 3/5/2004 14:53' prior: 0!
I am a fragment of a RFBMessage representing the foreground and background colours of a cursor shape.!

WriteStream subclass: #RFBZLibFakeStream
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBZLibFakeStream commentStamp: 'ikp 3/17/2004 20:32' prior: 0!
I am a completely bogus ZLib write stream.

You write uncompressed data to me with #nextPutAll: and retrieve the 'compressed' data with #contents (followed by position: 0, if appropriate, to empty my output buffer).

If you expect a pause in your data stream then you should send me #synchronise.  This will ensure that *all* data is flushed through to the *final* consumer of the uncompressed data at the other end of the (e.g.) network connection.

You can therefore repeat the cycle:

	oneOfMe
		nextPutAll: yourUncompressedData;
		synchronise;
		contents;
		position: 0.

as many times as you like, each time sending the answer to #contents to a (possibly remote) consumer who is piping their incoming 'compressed' data through a zlib inflation process.  This consumer is *guaranteed* to receive all yourUncompressedData at each point you send #synchronise.

I am completely bogus because I don't compress anything at all.  The 'compressed' data is larger than the uncompressed data, but it *does* conform rigorously to the format described in RFC 1951.  You can therefore send the 'compressed' data I produce to any conforming implementation of zlib and expect to retrieve the original data, with inflation 'latencies' managed correctly as per the synchronisation behaviour described above.!

ZLibReadStream subclass: #RFBZLibReadStream
	instanceVariableNames: 'getPixel getCPixel pixelBuffer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Viewer'!

!RFBZLibReadStream commentStamp: 'ikp 3/23/2004 12:06' prior: 0!
I am a ZLibReadStream that understands how to decompress pixel values.!

ZLibWriteStream subclass: #RFBZLibWriteStream
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Communication'!

!RFBZLibWriteStream commentStamp: 'ikp 3/24/2004 00:19' prior: 0!
I am a ZLibWriteStream that understands how to synchronise my encodedData with a remote inflation process.  At each synchronisation point I write a marker to the encodedStream that will cause the inflation process in the remote client to ensure that all preceding data has been inflated and presented to the final consumer, avoiding any possibility for data to become 'stuck' in the inflation buffer.  This is most convenient when encoded data is being sent over a network and contains (for example) interactive screen updates.!

RFBMessage variableByteSubclass: #RFBZRLEHeader
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'RFB-Messages'!

!RFBZRLEHeader commentStamp: 'ikp 3/18/2004 04:05' prior: 0!
I am a header for an update rectangle in ZRLE (Zlib Run Length Encoding) format.!


!EventSensorConstants class methodsFor: 'encoding' stamp: 'ikp 3/7/2004 20:10'!
keysDo: aBlock
	"Answer the names of my class variables.  Avoids a notifier when the Encoder is finding a list of alternatives for a misspelled or undeclared class variable."

	^classPool keysDo: aBlock! !


!RFB3DES methodsFor: 'initialise-release' stamp: 'ikp 3/5/2004 12:13'!
initialise
	"Default conditions: ready to en/decrypt, but with useless (null) keys."

	knl _ WordArray new: 32.
	knr _ WordArray new: 32.
	kn3 _ WordArray new: 32! !

!RFB3DES methodsFor: 'accessing' stamp: 'ikp 3/5/2004 12:17'!
decryptionKey: newKey
	"Set the internal DES key to newKey, in a form appropriate for data decryption."

	self desKey: newKey mode: #DE1! !

!RFB3DES methodsFor: 'accessing' stamp: 'ikp 3/5/2004 13:28'!
des: inBlock to: outBlock
	"Encrypt or decrypt 8 bytes of data from inBlock, storing the result in outBlock.
	Note: inBlock can == outBlock (which is useful for implicitly destroying plaintext data during encryption)."

	| workArray |
	workArray _ WordArray new: 2.
	1 to: inBlock size - 7 by: 8 do:
		[:offset | self
			scrunch: inBlock to: workArray startingAt: offset;
			des: workArray key: knl;
			unscrunch: workArray to: outBlock startingAt: offset]! !

!RFB3DES methodsFor: 'accessing' stamp: 'ikp 3/5/2004 12:17'!
encryptionKey: newKey
	"Set the internal DES key to newKey, in a form appropriate for data encryption."

	self desKey: newKey mode: #EN0! !

!RFB3DES methodsFor: 'accessing' stamp: 'ikp 3/5/2004 12:20'!
useKey: cookedKey
	"Set the internal DES key to cookedKey.
	Note: you almost certainly don't want to invoke this method directly (use #de/encryptionKey: instead), but if you do then you are responsible for cooking your own raw key beforehand."

	knl _ cookedKey! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 12:21'!
cookey: raw
	"Answer a cooked version of the given raw key."

	| raw1 dough cook raw0 cooked |
	raw1 _ 1.
	dough _ WordArray new: 32.
	cook _ 1.
	16 timesRepeat:
		[raw0 _ raw1.
		 raw1 _ raw1 + 1.
		 cooked _				(((raw at: raw0) bitAnd: 16r00FC0000) bitShift: 6).
		 cooked _ cooked bitOr:	(((raw at: raw0) bitAnd: 16r00000FC0) bitShift: 10).
		 cooked _ cooked bitOr:	(((raw at: raw1) bitAnd: 16r00FC0000) bitShift: -10).
		 cooked _ cooked bitOr:	(((raw at: raw1) bitAnd: 16r00000FC0) bitShift: -6).
		 dough at: cook put: cooked.
		 cook _ cook + 1.
		 cooked _				(((raw at: raw0) bitAnd: 16r0003F000) bitShift: 12).
		 cooked _ cooked bitOr:	(((raw at: raw0) bitAnd: 16r0000003F) bitShift: 16).
		 cooked _ cooked bitOr:	(((raw at: raw1) bitAnd: 16r0003F000) bitShift: -4).
		 cooked _ cooked bitOr:	(((raw at: raw1) bitAnd: 16r0000003F)).
		 dough at: cook put: cooked.
		 cook _ cook + 1.
		 raw1 _ raw1 + 1].
	self useKey: dough! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 13:26'!
des: block key: keyArray
	"Perform DES en/decryption on the given data block using the keys stored in keyArray.  Update the data block in-place with the result."

	| leftt right work keys fval |
	leftt _ block at: 1.
	right _ block at: 2.
	work _ ((leftt bitShift: -4) bitXor: right) bitAnd: 16r0F0F0F0F.
	right _ right bitXor: work.
	leftt _ leftt bitXor: (work bitShift: 4).
	work _ ((leftt bitShift: -16) bitXor: right) bitAnd: 16r0000FFFF.
	right _ right bitXor: work.
	leftt _ leftt bitXor: (work bitShift: 16).
	work _ ((right bitShift: -2) bitXor: leftt) bitAnd: 16r33333333.
	leftt _ leftt bitXor: work.
	right _ right bitXor: (work bitShift: 2).
	work _ ((right bitShift: -8) bitXor: leftt) bitAnd: 16r00FF00FF.
	leftt _ leftt bitXor: work.
	right _ right bitXor: (work bitShift: 8).
	right _ ((right bitShift: 1) bitOr: ((right bitShift: -31) bitAnd: 1)) bitAnd: 16rFFFFFFFF.
	work _ (leftt bitXor: right) bitAnd: 16rAAAAAAAA.
	leftt _ leftt bitXor: work.
	right _ right bitXor: work.
	leftt _ ((leftt bitShift: 1) bitOr: ((leftt bitShift: -31) bitAnd: 1)) bitAnd: 16rFFFFFFFF.
	keys _ ReadStream on: keyArray.
	8 timesRepeat:
		[work _ ((right bitShift: 28) bitOr: (right bitShift: -4)) bitAnd: 16rFFFFFFFF.
		work _ work bitXor: keys next.
		fval _				(SP7 at: 1 + ((work)				bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP5 at: 1 + ((work bitShift: -8)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP3 at: 1 + ((work bitShift: -16)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP1 at: 1 + ((work bitShift: -24)	bitAnd: 16r3F)).
		work _ right bitXor: keys next.
		fval _ fval bitOr:	(SP8 at: 1 + ((work)				bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP6 at: 1 + ((work bitShift: -8)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP4 at: 1 + ((work bitShift: -16)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP2 at: 1 + ((work bitShift: -24)	bitAnd: 16r3F)).
		leftt _ leftt bitXor: fval.
		work _ ((leftt bitShift: 28) bitOr: (leftt bitShift: -4)) bitAnd: 16rFFFFFFFF.
		work _ work bitXor: keys next.
		fval _ 				(SP7 at: 1 + ((work)				bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP5 at: 1 + ((work bitShift:  -8)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP3 at: 1 + ((work bitShift: -16)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP1 at: 1 + ((work bitShift: -24)	bitAnd: 16r3F)).
		work _ leftt bitXor: keys next.
		fval _ fval bitOr:	(SP8 at: 1 + ((work)				bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP6 at: 1 + ((work bitShift:  -8)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP4 at: 1 + ((work bitShift: -16)	bitAnd: 16r3F)).
		fval _ fval bitOr:	(SP2 at: 1 + ((work bitShift: -24)	bitAnd: 16r3F)).
		right _ right bitXor: fval].
	right _ ((right bitShift: 31) bitOr: (right bitShift: -1)) bitAnd: 16rFFFFFFFF.
	work _ (leftt bitXor: right) bitAnd: 16rAAAAAAAA.
	leftt _ leftt bitXor: work.
	right _ right bitXor: work.
	leftt _ ((leftt bitShift: 31) bitOr: (leftt bitShift: -1)) bitAnd: 16rFFFFFFFF.
	work _ ((leftt bitShift: -8) bitXor: right) bitAnd: 16r00FF00FF.
	right _ right bitXor: work.
	leftt _ leftt bitXor: (work bitShift: 8).
	work _ ((leftt bitShift: -2) bitXor: right) bitAnd: 16r33333333.
	right _ right bitXor: work.
	leftt _ leftt bitXor: (work bitShift: 2).
	work _ ((right bitShift: -16) bitXor: leftt) bitAnd: 16r0000FFFF.
	leftt _ leftt bitXor: work.
	right _ right bitXor: (work bitShift: 16).
	work _ ((right bitShift: -4) bitXor: leftt) bitAnd: 16r0F0F0F0F.
	leftt _ leftt bitXor: work.
	right _ right bitXor: (work bitShift: 4).
	block
		at: 1 put: right;
		at: 2 put: leftt! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 12:25'!
desKey: newKey mode: mode
	"Set the internal en/decryption key based a raw newKey.  If mode is #EN0 then the internally-set key will be suitable for encryption; if mode == #DE1 then it will be suitable for decryption."

	| pcr kn pc1m m n l |
	pcr _ ByteArray new: 56.
	kn _ WordArray new: 32.
	pc1m _ (PC1 collect: [:i |
				m _ i bitAnd: 7.
				((newKey at: 1 + (i bitShift: -3)) bitAnd: (ByteBit at: 1 + m)) ~~ 0
					ifTrue: [1]
					ifFalse: [0]])
		asByteArray.
	0 to: 15 do: [:i |
		m _ (mode == #DE1
				ifTrue: [15 - i]
				ifFalse: [i])
			 bitShift: 1.
		n _ m + 1.
		kn at: 1 + m put: (kn at: 1 + n put: 0).
		0 to: 27 do: [:j |
			l _ j + (TotRot at: 1 + i).
			pcr at: 1 + j put: (pc1m at: 1 + (l < 28 ifTrue: [l] ifFalse: [l - 28]))].
		28 to: 55 do: [:j |
			l _ j + (TotRot at: 1 + i).
			pcr at: 1 + j put: (pc1m at: 1 + (l < 56 ifTrue: [l] ifFalse: [l - 28]))].
		0 to: 23 do: [:j |
			0 ~~ (pcr at: 1 + (PC2 at: 1 + j))
				ifTrue: [kn at: 1 + m put: ((kn at: 1 + m) bitOr: (BigByte at: 1 + j))].
			0 ~~ (pcr at: 1 + (PC2 at: 1 + j + 24))
				ifTrue: [kn at: 1 + n put: ((kn at: 1 + n) bitOr: (BigByte at: 1 + j))]]].
	self cookey: kn! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 13:32'!
scrunch: bytes to: block
	"Create a 2-word DES data block from 8 bytes of user data."

	^self scrunch: bytes to: block startingAt: 1! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 13:31'!
scrunch: bytes to: block startingAt: index
	"Create a 2-word DES data block from 8 bytes of user data."

	| tmp |
	tmp _				((bytes at: index + 0) bitShift: 24).
	tmp _ tmp bitOr:	((bytes at: index + 1) bitShift: 16).
	tmp _ tmp bitOr:	((bytes at: index + 2) bitShift: 8).
	tmp _ tmp bitOr:	((bytes at: index + 3)).
	block at: 1 put: tmp.
	tmp _				((bytes at: index + 4) bitShift: 24).
	tmp _ tmp bitOr:	((bytes at: index + 5) bitShift: 16).
	tmp _ tmp bitOr:	((bytes at: index + 6) bitShift: 8).
	tmp _ tmp bitOr:	((bytes at: index + 7)).
	block at: 2 put: tmp! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 13:32'!
unscrunch: block to: bytes
	"Create 8 bytes of user data from a 2-word DES data block."

	^self unscrunch: block to: bytes startingAt: 1! !

!RFB3DES methodsFor: 'private' stamp: 'ikp 3/5/2004 13:32'!
unscrunch: block to: bytes startingAt: index
	"Create 8 bytes of user data from a 2-word DES data block."

	| tmp |
	tmp _ block at: 1.
	bytes at: index + 0 put: ((tmp bitShift: -24)	bitAnd: 16rFF).
	bytes at: index + 1 put: ((tmp bitShift: -16)	bitAnd: 16rFF).
	bytes at: index + 2 put: ((tmp bitShift: -8)	bitAnd: 16rFF).
	bytes at: index + 3 put: ((tmp 			)	bitAnd: 16rFF).
	tmp _ block at: 2.
	bytes at: index + 4 put: ((tmp bitShift: -24)	bitAnd: 16rFF).
	bytes at: index + 5 put: ((tmp bitShift: -16)	bitAnd: 16rFF).
	bytes at: index + 6 put: ((tmp bitShift: -8)	bitAnd: 16rFF).
	bytes at: index + 7 put: ((tmp 			)	bitAnd: 16rFF)! !


!RFB3DES class methodsFor: 'class initialisation' stamp: 'ikp 3/8/2004 04:37'!
initialize
	"Initialise the various magic tables used for DES encryption."
	"RFB3DES initialize"

	BigByte _ #(
		16r800000	16r400000	16r200000	16r100000
		16r080000	16r040000	16r020000	16r010000
		16r008000	16r004000	16r002000	16r001000
		16r000800	16r000400 	16r000200 	16r000100
		16r000080	16r000040	16r000020	16r000010
		16r000008	16r000004	16r000002	16r000001).
	ByteBit _ #(1 2 4 8 16 32 64 128).
	"Key schedule [ANSI X3.92-1981]."
	PC1 _ #(
		56 48  40 32 24 16  8		 0 57 49 41 33 25 17
		 9   1 58 50 42 34 26		18 10  2 59 51 43 35
		62 54  46 38 30 22 14		 6 61 53 45 37 29 21
		13   5 60 52 44 36 28		20 12  4 27 19 11  3).
	PC2 _ #(
	 	13 16 10 23  0  4  2 27 14  5 20  9
		22 18 11  3 25  7 15  6 26 19 12  1
		40 51 30 36 46 54 29 39 50 44 32 47
		43 48 38 55 33 52 45 41 49 35 28 31).
	TotRot _ #(1 2 4 6 8 10 12 14 15 17 19 21 23 25 27 28).
	SP1 _ #(
		16r01010400 16r00000000 16r00010000 16r01010404
		16r01010004 16r00010404 16r00000004 16r00010000
		16r00000400 16r01010400 16r01010404 16r00000400
		16r01000404 16r01010004 16r01000000 16r00000004
		16r00000404 16r01000400 16r01000400 16r00010400
		16r00010400 16r01010000 16r01010000 16r01000404
		16r00010004 16r01000004 16r01000004 16r00010004
		16r00000000 16r00000404 16r00010404 16r01000000
		16r00010000 16r01010404 16r00000004 16r01010000
		16r01010400 16r01000000 16r01000000 16r00000400
		16r01010004 16r00010000 16r00010400 16r01000004
		16r00000400 16r00000004 16r01000404 16r00010404
		16r01010404 16r00010004 16r01010000 16r01000404
		16r01000004 16r00000404 16r00010404 16r01010400
		16r00000404 16r01000400 16r01000400 16r00000000
		16r00010004 16r00010400 16r00000000 16r01010004).
	SP2 _ #(
		16r80108020 16r80008000 16r00008000 16r00108020
		16r00100000 16r00000020 16r80100020 16r80008020
		16r80000020 16r80108020 16r80108000 16r80000000
		16r80008000 16r00100000 16r00000020 16r80100020
		16r00108000 16r00100020 16r80008020 16r00000000
		16r80000000 16r00008000 16r00108020 16r80100000
		16r00100020 16r80000020 16r00000000 16r00108000
		16r00008020 16r80108000 16r80100000 16r00008020
		16r00000000 16r00108020 16r80100020 16r00100000
		16r80008020 16r80100000 16r80108000 16r00008000
		16r80100000 16r80008000 16r00000020 16r80108020
		16r00108020 16r00000020 16r00008000 16r80000000
		16r00008020 16r80108000 16r00100000 16r80000020
		16r00100020 16r80008020 16r80000020 16r00100020
		16r00108000 16r00000000 16r80008000 16r00008020
		16r80000000 16r80100020 16r80108020 16r00108000).
	SP3 _ #(
		16r00000208 16r08020200 16r00000000 16r08020008
		16r08000200 16r00000000 16r00020208 16r08000200
		16r00020008 16r08000008 16r08000008 16r00020000
		16r08020208 16r00020008 16r08020000 16r00000208
		16r08000000 16r00000008 16r08020200 16r00000200
		16r00020200 16r08020000 16r08020008 16r00020208
		16r08000208 16r00020200 16r00020000 16r08000208
		16r00000008 16r08020208 16r00000200 16r08000000
		16r08020200 16r08000000 16r00020008 16r00000208
		16r00020000 16r08020200 16r08000200 16r00000000
		16r00000200 16r00020008 16r08020208 16r08000200
		16r08000008 16r00000200 16r00000000 16r08020008
		16r08000208 16r00020000 16r08000000 16r08020208
		16r00000008 16r00020208 16r00020200 16r08000008
		16r08020000 16r08000208 16r00000208 16r08020000
		16r00020208 16r00000008 16r08020008 16r00020200).
	SP4 _ #(
		16r00802001 16r00002081 16r00002081 16r00000080
		16r00802080 16r00800081 16r00800001 16r00002001
		16r00000000 16r00802000 16r00802000 16r00802081
		16r00000081 16r00000000 16r00800080 16r00800001
		16r00000001 16r00002000 16r00800000 16r00802001
		16r00000080 16r00800000 16r00002001 16r00002080
		16r00800081 16r00000001 16r00002080 16r00800080
		16r00002000 16r00802080 16r00802081 16r00000081
		16r00800080 16r00800001 16r00802000 16r00802081
		16r00000081 16r00000000 16r00000000 16r00802000
		16r00002080 16r00800080 16r00800081 16r00000001
		16r00802001 16r00002081 16r00002081 16r00000080
		16r00802081 16r00000081 16r00000001 16r00002000
		16r00800001 16r00002001 16r00802080 16r00800081
		16r00002001 16r00002080 16r00800000 16r00802001
		16r00000080 16r00800000 16r00002000 16r00802080).
	SP5 _ #(
		16r00000100 16r02080100 16r02080000 16r42000100
		16r00080000 16r00000100 16r40000000 16r02080000
		16r40080100 16r00080000 16r02000100 16r40080100
		16r42000100 16r42080000 16r00080100 16r40000000
		16r02000000 16r40080000 16r40080000 16r00000000
		16r40000100 16r42080100 16r42080100 16r02000100
		16r42080000 16r40000100 16r00000000 16r42000000
		16r02080100 16r02000000 16r42000000 16r00080100
		16r00080000 16r42000100 16r00000100 16r02000000
		16r40000000 16r02080000 16r42000100 16r40080100
		16r02000100 16r40000000 16r42080000 16r02080100
		16r40080100 16r00000100 16r02000000 16r42080000
		16r42080100 16r00080100 16r42000000 16r42080100
		16r02080000 16r00000000 16r40080000 16r42000000
		16r00080100 16r02000100 16r40000100 16r00080000
		16r00000000 16r40080000 16r02080100 16r40000100).
	SP6 _ #(
		16r20000010 16r20400000 16r00004000 16r20404010
		16r20400000 16r00000010 16r20404010 16r00400000
		16r20004000 16r00404010 16r00400000 16r20000010
		16r00400010 16r20004000 16r20000000 16r00004010
		16r00000000 16r00400010 16r20004010 16r00004000
		16r00404000 16r20004010 16r00000010 16r20400010
		16r20400010 16r00000000 16r00404010 16r20404000
		16r00004010 16r00404000 16r20404000 16r20000000
		16r20004000 16r00000010 16r20400010 16r00404000
		16r20404010 16r00400000 16r00004010 16r20000010
		16r00400000 16r20004000 16r20000000 16r00004010
		16r20000010 16r20404010 16r00404000 16r20400000
		16r00404010 16r20404000 16r00000000 16r20400010
		16r00000010 16r00004000 16r20400000 16r00404010
		16r00004000 16r00400010 16r20004010 16r00000000
		16r20404000 16r20000000 16r00400010 16r20004010).
	SP7 _ #(
		16r00200000 16r04200002 16r04000802 16r00000000
		16r00000800 16r04000802 16r00200802 16r04200800
		16r04200802 16r00200000 16r00000000 16r04000002
		16r00000002 16r04000000 16r04200002 16r00000802
		16r04000800 16r00200802 16r00200002 16r04000800
		16r04000002 16r04200000 16r04200800 16r00200002
		16r04200000 16r00000800 16r00000802 16r04200802
		16r00200800 16r00000002 16r04000000 16r00200800
		16r04000000 16r00200800 16r00200000 16r04000802
		16r04000802 16r04200002 16r04200002 16r00000002
		16r00200002 16r04000000 16r04000800 16r00200000
		16r04200800 16r00000802 16r00200802 16r04200800
		16r00000802 16r04000002 16r04200802 16r04200000
		16r00200800 16r00000000 16r00000002 16r04200802
		16r00000000 16r00200802 16r04200000 16r00000800
		16r04000002 16r04000800 16r00000800 16r00200002).
	SP8 _ #(
		16r10001040 16r00001000 16r00040000 16r10041040
		16r10000000 16r10001040 16r00000040 16r10000000
		16r00040040 16r10040000 16r10041040 16r00041000
		16r10041000 16r00041040 16r00001000 16r00000040
		16r10040000 16r10000040 16r10001000 16r00001040
		16r00041000 16r00040040 16r10040040 16r10041000
		16r00001040 16r00000000 16r00000000 16r10040040
		16r10000040 16r10001000 16r00041040 16r00040000
		16r00041040 16r00040000 16r10041000 16r00001000
		16r00000040 16r10040040 16r00001000 16r00041040
		16r10001000 16r00000040 16r10000040 16r10040000
		16r10040040 16r10000000 16r00040000 16r10001040
		16r00000000 16r10041040 16r00040040 16r10000040
		16r10040000 16r10001000 16r10001040 16r00000000
		16r10041040 16r00041000 16r00041000 16r00001040
		16r00001040 16r00040040 16r10000000 16r10041000).
! !

!RFB3DES class methodsFor: 'instance creation' stamp: 'ikp 3/5/2004 12:13'!
new
	"Create a new 3des algorithm with a null (all zeros) key."

	^super new initialise! !

!RFB3DES class methodsFor: 'examples' stamp: 'ikp 3/5/2004 13:35'!
example1
	"Encrypts the password 'squeak' and verifies that the result is as expected.
	Note: if you use 'squeak' as your real password then: (1) you are crazy to think such an obvious word is secure; and: (2) anybody who gains access to your image for more than 10 seconds will be in a position to look at the stored (encrypted) VNC password, compare it with the expected result below, and know instantly that your password is 'squeak'.  You have been warned."
	"RFB3DES example1"

	| data des |
	data _ (ByteArray new: 8) replaceFrom: 1 to: 6 with: 'squeak'.
	des _ RFB3DES new encryptionKey: #(23 82 107 6 35 78 88 7) asByteArray.
	des des: data to: data.
	data = #(252 108 241 14 193 201 46 62) asByteArray
		ifFalse: [self error: 'something rotten in the works'].
	^data! !


!RFBBitBlt methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:13'!
sourceAndDestRect: aRectangle
	"Set source and destination rectangles in one operation.  Avoids additional message sends."

	| origin corner x y |	
	origin _ aRectangle origin.
	corner _ aRectangle corner.
	sourceX _ destX _ (x _ origin x).
	sourceY _ destY _ (y _ origin y).
	width _ corner x - x.
	height _ corner y - y.! !

!RFBBitBlt methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:11'!
sourceForm: aForm sourceAndDestRect: aRectangle
	"Set the source form and the source and destination Ractangles.  Avoids several message sends."

	| origin corner x y |
	origin _ aRectangle origin.
	corner _ aRectangle corner.
	sourceForm _ aForm.
	sourceX _ destX _ x _ origin x.
	sourceY _ destY _ y _ origin y.
	width _ corner x - x.
	height _ corner y - y.! !

!RFBBitBlt methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:12'!
sourceX: x width: w
	"Set the horizontal source position and the width.  Avoids an additional message send from inner loops."

	sourceX _ x.
	width _ w! !

!RFBBitBlt methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:12'!
sourceY: y height: h
	"Set the vertical source position and the height.  Avoids an additional message send from inner loops."

	sourceY _ y.
	height _ h! !

!RFBBitBlt methodsFor: 'copying' stamp: 'ikp 3/23/2004 05:29'!
pixelsIn: aRectangle put: aPixel
	"Fill aRectangle in destForm with aPixel."

	| depth pv |
	depth _ halftoneForm depth.
	pv _ aPixel.
	depth < 32
		ifTrue:
			[pv _ pv bitOr: (pv bitShift: 16).
			 depth < 16 ifTrue: [pv _ pv bitOr: (pv bitShift: 8)]].
	halftoneForm bits at: 1 put: pv.
	self destRect: aRectangle; copyBits! !

!RFBBitBlt methodsFor: 'fileIn/Out' stamp: 'ikp 3/7/2004 20:11'!
unhibernate

	"Unhibernate my destForm when coming back from snapshot.  Avoids a problem with pixelAt: storing zero in the first field of destForm bits, which might be a ByteArray when the form is hibernating."

	destForm isNil ifFalse: [destForm unhibernate]! !


!RFBBitBlt class methodsFor: 'instance creation' stamp: 'ikp 3/23/2004 05:22'!
bitFillerToForm: destForm
	"Answer a BitBlt suitable for filling regions of destForm with pixel values (not Colors, regardless of the destForm depth)."

	destForm unhibernate.
	^self
		destForm: destForm
	 	sourceForm: nil
		halftoneForm: (Form extent: 1@1 depth: destForm depth)
		combinationRule: Form over
		destOrigin: 0@0
		sourceOrigin: 0@0
		extent: 1@1
		clipRect: destForm boundingBox! !

!RFBBitBlt class methodsFor: 'instance creation' stamp: 'ikp 3/7/2004 20:15'!
bitPeekerFromForm: destForm
	"Answer a BitBlt suitable for peeking pixel values out of destForm."

	^(super bitPeekerFromForm: destForm) colorMap: nil! !

!RFBBitBlt class methodsFor: 'instance creation' stamp: 'ikp 3/23/2004 04:19'!
bitPokerToForm: destForm
	"Answer a BitBlt suitable for poking pixel values into destForm."

	^(super bitPokerToForm: destForm) colorMap: nil! !


!RFBClient methodsFor: 'initialise-release' stamp: 'ikp 3/23/2004 11:51'!
initialise
	"Initial conditions."

	image _ RFBClientForm extent: 0@0 depth: Display depth.
	serverExtent _ 0@0.
	sendLock _ Semaphore forMutualExclusion.
	updateRequestPending _ true.
	currentCursor _ nil.
	savedCursor _ nil.
	hasCursor _ false.
	modifierState _ 0! !

!RFBClient methodsFor: 'accessing' stamp: 'ikp 3/23/2004 13:13'!
contentBounds

	^scrollPane contentBounds! !

!RFBClient methodsFor: 'accessing' stamp: 'ikp 3/23/2004 06:25'!
fastUpdate
	"Answer whether updates should be fast (uses more memory and impacts interactive response in other processes) or not (uses less memory and yields the Processor often)."

	^FastUpdate! !

!RFBClient methodsFor: 'accessing' stamp: 'ikp 3/21/2004 03:41'!
preferredEncoding
	"Answer the preferred encoding, according to the current preferences."

	DefaultEncoding == RfbEncodingAuto ifFalse: [^DefaultEncoding].
	self connectionIsLocal
		ifTrue: [^RfbEncodingRaw]
		ifFalse: [^RfbEncodingHextile]! !

!RFBClient methodsFor: 'accessing' stamp: 'ikp 3/23/2004 07:56'!
serverFormat
	"Answer the pixel format in use on the server."

	^serverFormat! !

!RFBClient methodsFor: 'testing' stamp: 'ikp 3/24/2004 01:15'!
connectionIsLocal
	"Answer whether the receiver is connected to a server on the same machine."

	| peer |
	peer _ socket remoteAddress.
	^peer = #(127 0 0 1) asByteArray or: [peer = NetNameResolver localHostAddress]! !

!RFBClient methodsFor: 'testing' stamp: 'ikp 3/22/2004 10:54'!
isActive
	"Answer whether the receiver is currently connected and ready to send normal protocol messages."

	^socket notNil and: [state == #rfbNormal]! !

!RFBClient methodsFor: 'testing' stamp: 'ikp 3/20/2004 22:47'!
isConnected
	"Answer whether the receiver is currently connected."

	^socket notNil! !

!RFBClient methodsFor: 'opening' stamp: 'ikp 3/23/2004 11:52'!
open
	"Open a RFBClient window."

	(scrollPane _ RFBScrollPane new)
		extent: ((self width min: 300 max: 100) @ (self height min: 150 max: 100));
		borderWidth: 0.
	scrollPane scroller addMorph: self.
	scrollPane
		setScrollDeltas;
		color: self color darker;
		model: self.
	window _ (RFBSystemWindow labelled: WindowLabel) model: self.
	window addMorph: scrollPane frame: (0@0 corner: 1@1).
	window openInWorld! !

!RFBClient methodsFor: 'connecting' stamp: 'ikp 3/24/2004 04:21'!
connect
	"Open a new connection."

	self isConnected ifTrue: [^self inform: 'This viewer is already connected.'].
	(socket _ RFBClientSocket connectedToServer) isNil ifTrue: [^self].
	process _ [self clientRunLoop] forkAt: self clientPriority! !

!RFBClient methodsFor: 'connecting' stamp: 'ikp 3/23/2004 10:33'!
disconnect
	"Close the new connection."

	self isConnected ifFalse: [^self inform: 'This viewer is not connected.'].
	(self confirm: 'Really disconnect?') ifTrue: [self abort]! !

!RFBClient methodsFor: 'menu' stamp: 'ikp 3/24/2004 06:02'!
encodingsMenu
	"Answer the encodings submenu."

	^RFBMenuMorph new
		add: 'auto' get: [DefaultEncoding == RfbEncodingAuto]
			set: [self setDefaultEncoding: RfbEncodingAuto]
			help: 'Automatically select the most appropriate encoding.';
		addLine;
		add: 'Hextile' get: [DefaultEncoding == RfbEncodingHextile]
			set: [self setDefaultEncoding: RfbEncodingHextile]
			help: 'Use Hextile encoding.';
		add: 'CoRRE' get: [DefaultEncoding == RfbEncodingCoRRE]
			set: [self setDefaultEncoding: RfbEncodingCoRRE]
			help: 'Use Compressed Rise and Run-length Encoding.';
		add: 'RRE' get: [DefaultEncoding == RfbEncodingRRE]
			set: [DefaultEncoding _ RfbEncodingRRE]
			help: 'Use Rise and Run-length Encoding.';
		add: 'Raw' get: [DefaultEncoding == RfbEncodingRaw]
			set: [self setDefaultEncoding: RfbEncodingRaw]
			help: 'Use Raw encoding.';
		add: 'ZRLE' get: [DefaultEncoding == RfbEncodingZRLE]
			set: [self setDefaultEncoding: RfbEncodingZRLE]
			help: 'Use Zlib Run-Length Encoding.';
		yourself! !

!RFBClient methodsFor: 'menu' stamp: 'ikp 3/23/2004 10:33'!
getMenu: shiftState
	"Answer the menu attached to the yellow button (and to the scrollbar button if visible)."

	| menu |
	(menu _ RFBMenuMorph new)		"We're NOT a text holder.  Grrr...!!"
		defaultTarget: self.
	self isConnected
		ifTrue: [menu add: 'disconnect...' action: #disconnect help: 'Disconnect from the server.']
		ifFalse: [menu add: 'connect...' action: #connect help: 'Connect to a server.'].
	menu
		addLine;
		add: 'options' subMenu: self optionsMenu;
		add: 'encodings' subMenu: self encodingsMenu;
		add: 'performance' subMenu: self performanceMenu;
		addLine;
		add: 'help...' action: #showHelpWindow help: 'Open a window describing this menu in detail.';
		add: 'about...' action: #showAboutWindow help: 'Open the Cheezoid About Window.';
		addLine;
		add: 'inspect...' action: #inspect.
	^menu! !

!RFBClient methodsFor: 'menu' stamp: 'ikp 3/21/2004 04:16'!
optionsMenu
	"Answer the options submenu."

	^RFBMenuMorph new
		add: 'shared' get: [EnableShared] set: [EnableShared _ EnableShared not]
			help: 'Share the connection with other clients.';
		add: 'local cursor' get: [EnableXCursor] set: [EnableXCursor _ EnableXCursor not]
			help: 'Local cursor shape tracks server cursor shape.';
		add: 'view-only' get: [EnableViewOnly] set: [EnableViewOnly _ EnableViewOnly not]
			help: 'Do not send mouse and keyboard events to the server.';
		add: '8-bit pixels' get: [Enable8Bit] set: [Enable8Bit _ Enable8Bit not]
			help: 'Use 8-bit depth to reduce bandwidth requirements.';
		yourself! !

!RFBClient methodsFor: 'menu' stamp: 'ikp 3/23/2004 07:17'!
performanceMenu
	"Answer the performance submenu."

	^RFBMenuMorph new
		add: 'fast update' get: [FastUpdate] set: [FastUpdate _ FastUpdate not]
			help: 'Trade resources for update speed.  When enabled, updates will use more memory and the Processor will be devoted to processing the update (reducing interactive response in other windows).  When disabled, updates will use very little memory and the Processor will yield often (preserving response in other windows).';
		yourself! !

!RFBClient methodsFor: 'menu' stamp: 'ikp 3/24/2004 05:15'!
showAboutWindow
	"Display a cheesy about window."

	(StringHolder new contents: self aboutString)
		openLabel: 'About the RFB/VNC Client (viewer)'! !

!RFBClient methodsFor: 'menu' stamp: 'ikp 3/24/2004 05:15'!
showHelpWindow
	"Display a help window."

	(StringHolder new contents: self helpString)
		openLabel: 'Help for the RFB/VNC Client (viewer)'! !

!RFBClient methodsFor: 'client process' stamp: 'ikp 3/20/2004 08:26'!
clientPriority
	"Answer the scheduling priority at which the client should run."
	"Note: since the client performs Morphic screen updates, it is highly likely that it will break Morphic if it runs at anything higher than userSchedulingPriority."

	^Processor userSchedulingPriority! !

!RFBClient methodsFor: 'client process' stamp: 'ikp 3/22/2004 04:44'!
clientRunLoop
	"Run the loop in which the client sends and receives messages."

	state _ #rfbProtocolVersion.
	socket runSafely:
		[socket waitForData.
		 self perform: state]! !

!RFBClient methodsFor: 'client messages' stamp: 'ikp 3/21/2004 03:33'!
sendClientInitialisation
	"Send a client initialisation message to the server.  This is a 1-byte flag indicating whether the connection should be shared."

	socket sendData: (RFBMessage with: (EnableShared ifTrue: [1] ifFalse: [0])).
	state _ #rfbInitialisation! !

!RFBClient methodsFor: 'client messages' stamp: 'ikp 3/21/2004 03:32'!
sendFramebufferUpdateRequest: updateBounds incremental: incrementalFlag
	"Send a framebufferUpdateRequest to the server."

	self sendData: (RFBFramebufferUpdateRequest
						bounds: updateBounds
						incremental: incrementalFlag)! !

!RFBClient methodsFor: 'client messages' stamp: 'ikp 3/23/2004 11:53'!
sendKeyEvent: keyCode down: downFlag
	"Send a key event with keyCode to keySym translation."

	self
		sendData: (RFBKeyEvent key: keyCode down: downFlag);
		sendPeriodicUpdateRequest! !

!RFBClient methodsFor: 'client messages' stamp: 'ikp 3/23/2004 11:50'!
sendPointerEvent: buttonMask position: aPoint
	"Send a pointer event."

	self
		sendData: (RFBPointerEvent
						buttonMask: (self encodeButtons: buttonMask)
						position: (self mousePoint: aPoint));
		sendPeriodicUpdateRequest! !

!RFBClient methodsFor: 'client messages' stamp: 'ikp 3/24/2004 04:39'!
sendSetEncodings
	"Send a set encodings message to the server according to the current preferences."

	| encodings preferred setEncodings |
	preferred _ self preferredEncoding.
	(preferred == RfbEncodingZRLE and: [protocolMinor < 7])
		ifTrue: [preferred _ RfbEncodingHextile].
	(encodings _ OrderedCollection new)
		add: preferred;
		add: RfbEncodingHextile;
		add: RfbEncodingCoRRE;
		add: RfbEncodingRRE;
		add: RfbEncodingRaw.
	EnableXCursor ifTrue: [encodings add: RfbEncodingXCursor].
	setEncodings _ RFBSetEncodings new: encodings size.
	encodings doWithIndex: [:encoding :index | setEncodings encodingAt: index put: encoding].
	self sendData: setEncodings! !

!RFBClient methodsFor: 'server messages' stamp: 'ikp 3/22/2004 04:42'!
rfbBell
	"Read and process a bell message".

	Display beepPrimitive! !

!RFBClient methodsFor: 'server messages' stamp: 'ikp 3/22/2004 04:48'!
rfbFramebufferUpdate
	"Read and process a framebuffer update message."

	| header update |
	header _ RFBFramebufferUpdateRectHeader new.
	update _ socket receiveNew: RFBFramebufferUpdate.
	update nRects timesRepeat: [self processUpdate: (socket receiveData: header)]! !

!RFBClient methodsFor: 'server messages' stamp: 'ikp 3/22/2004 04:27'!
rfbServerCutText
	"Read and process a server cut text message"

	| length string |
	length _ (socket receiveNew: RFBClientCutText) length.
	string _ socket receiveData: (String new: length).
	Clipboard clipboardText: string asText! !

!RFBClient methodsFor: 'server messages' stamp: 'ikp 3/20/2004 23:09'!
rfbSetColourMapEntries
	"Read and process a set colourmap entries message".

self log: 'rfbSetColourMapEntries'.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'message dispatching' stamp: 'ikp 3/22/2004 11:15'!
rfbAuthentication
	"Read and process an incoming authentication challenge.  Prompt the user for a password and send back the encrypted response."

	| message password |
	message _ socket receiveData: (RFBMessage new: 16).
	password _ FillInTheBlank requestPassword: 'password?'. 
	message _ self encryptChallenge: message with: password.
	socket sendData: message.
	"Read the authentication response immediately."
	message _ socket receiveData: (RFBMessage new: 4).
	message opcode == RFBMessage rfbVncAuthOK ifTrue: [^self sendClientInitialisation].
	self connectionFailed: 'permission denied'! !

!RFBClient methodsFor: 'message dispatching' stamp: 'ikp 3/22/2004 11:15'!
rfbAuthenticationType
	"We're in version 3.3 handshake.  Read a 4-byte authentication type message from the server."

	| message type |
	message _ socket receiveData: (RFBMessage new: 4).
	type _ message opcode.
	type == RFBMessage rfbNoAuth ifTrue: [^self sendClientInitialisation].
	type == RFBMessage rfbVncAuth ifTrue: [^state _ #rfbAuthentication].
	self connectionFailed: 'unknown authentication type: ', type printString! !

!RFBClient methodsFor: 'message dispatching' stamp: 'ikp 3/24/2004 04:04'!
rfbInitialisation
	"Read and process an incoming server initialisation message."

	| message |
	message _ socket receiveData: RFBServerInitialisation new.
	serverExtent _ message width @ message height.
	serverFormat _ message pixelFormat setReverseMaps.
	self log: 'server pixel format ', serverFormat printString.
	serverName _ socket receiveString.
	self sendSetEncodings.
	self setExtent.
	window setLabel: serverName.
	socket
		initialiseForDepth: serverFormat bitsPerPixel
		mask: serverFormat pixelMask
		byteSwapped: serverFormat bigEndian not.
	state _ #rfbNormal.
	updateRequestPending _ false.
	self sendFullUpdateRequest! !

!RFBClient methodsFor: 'message dispatching' stamp: 'ikp 3/22/2004 04:55'!
rfbNormal
	"Receive and process an incoming normal protocol message."

	| type |
	type _ (socket receiveData: (RFBMessage new: 1)) byteAt: 1.
	(type < 0) | (type >= MessageTypes size)
		ifTrue:
			[self log: 'illegal message type ' , type printString , ' received'.
			 ^self abort].
	self perform: (MessageTypes at: 1 + type).
	updateRequestPending _ true.
	self sendPeriodicUpdateRequest! !

!RFBClient methodsFor: 'message dispatching' stamp: 'ikp 3/22/2004 11:14'!
rfbProtocolVersion
	"Receive and process an incoming protocol version message.  Check compatibility and reply with our protocol version, then expect an authentication type message (3.3) or a security types message (3.7)."

	| message protocolMajor |
	message _ socket receiveData: (String new: 12).
	protocolMajor _ (message copyFrom: 5 to: 7) asInteger.
	protocolMinor _ (message copyFrom: 9 to: 11) asInteger.
	self log: 'server version ', protocolMajor printString, '.', protocolMinor printString.
	self log: 'viewer version ', ProtocolMajor printString, '.', ProtocolMinor printString.
	protocolMinor _ protocolMinor min: ProtocolMinor.
	(protocolMinor < 7 and: [protocolMinor > 3]) ifTrue: [protocolMinor _ 3].
	socket sendData: (RFBMessage protocolVersionMajor: ProtocolMajor minor: protocolMinor).
	protocolMajor == ProtocolMajor
		ifTrue:
			[protocolMinor == 3 ifTrue: [^state _ #rfbAuthenticationType].
			 protocolMinor == 7 ifTrue: [^state _ #rfbSecurityTypes]].
	self connectionFailed: 'incompatible protocol version'! !

!RFBClient methodsFor: 'message dispatching' stamp: 'ikp 3/22/2004 11:14'!
rfbSecurityTypes
	"We're in version 3.7 handshake.  Read a list of supported security schemes and reply with the one we prefer."

	| message count |
	message _ socket receiveData: (RFBMessage new: 1).
	count _ message type.
	count == 0 ifTrue: [^self connectionFailed].
	message _ socket receiveData: (RFBMessage new: count).
	(message indexOf: RFBMessage rfbNoAuth) ~~ 0
		ifTrue:
			[socket sendData: (RFBMessage with: RFBMessage rfbNoAuth).
			 ^self sendClientInitialisation].
	(message indexOf: RFBMessage rfbVncAuth) ~~ 0
		ifTrue:
			[socket sendData: (RFBMessage with: RFBMessage rfbVncAuth).
			 ^state _ #rfbAuthentication].
	^self connectionFailed: ['no supported security type']! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/22/2004 01:56'!
processUpdate: updateHeader
	"Process a framebuffer update rectangle."

	| type |
	self
		perform: (Encodings at: (type _ updateHeader type) ifAbsent: [#rfbEncodingUnknown:])
		with: updateHeader! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/23/2004 08:22'!
rfbEncodingCoRRE: updateHeader
	"Process a compressed rise and run-length encoding update."

	| form updateBounds |
	updateBounds _ updateHeader bounds.
	form _ RFBClientForm extent: updateBounds extent depth: serverFormat bitsPerPixel.
	form correDecode: (0@0 extent: updateBounds extent) from: socket for: nil.
	self display: form on: image in: updateBounds.
	FastUpdate ifFalse: [Processor yield]! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:56'!
rfbEncodingCopyRect: updateHeader
	"Process a copy rect encoding update."

	self log: 'rfbEncodingCopyRect: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/23/2004 07:36'!
rfbEncodingHextile: updateHeader
	"Process a hextile encoding update."

	| form updateBounds |
	updateBounds _ updateHeader bounds.
	FastUpdate
		ifTrue:
			[form _ RFBClientForm extent: updateBounds extent depth: serverFormat bitsPerPixel.
			 form hextileDecode: (0@0 extent: updateBounds extent) from: socket for: nil.
			 self display: form on: image in: updateBounds]
		ifFalse:
			[image hextileDecode: updateBounds from: socket for: self]! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:56'!
rfbEncodingLastRect: updateHeader
	"Process a last rectangle update."

	self log: 'rfbEncodingLastRect: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:56'!
rfbEncodingPointerPos: updateHeader
	"Process a pointer position update."

	self log: 'rfbEncodingPointerPos: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/23/2004 08:12'!
rfbEncodingRRE: updateHeader
	"Process a rise and run-length encoding update."

	| form updateBounds |
	updateBounds _ updateHeader bounds.
	form _ RFBClientForm extent: updateBounds extent depth: serverFormat bitsPerPixel.
	form rreDecode: (0@0 extent: updateBounds extent) from: socket for: nil.
	self display: form on: image in: updateBounds.
	FastUpdate ifFalse: [Processor yield]! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/23/2004 06:51'!
rfbEncodingRaw: updateHeader
	"Process a raw encoding update."

	| form updateBounds |
	updateBounds _ updateHeader bounds.
	form _ RFBForm extent: updateBounds extent depth: serverFormat bitsPerPixel.
	self receiveForm: form.
	self display: form on: image in: updateBounds! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:56'!
rfbEncodingRichCursor: updateHeader
	"Process a rich cursor update."

	self log: 'rfbEncodingRichCursor: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:56'!
rfbEncodingTight: updateHeader
	"Process a tight encoding update."

	self log: 'rfbEncodingTight: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/22/2004 03:40'!
rfbEncodingUnknown: updateHeader
	"Process an unknown encoding update."

	self log: 'rfbEncodingUnknown: ', updateHeader printString.
	self connectionFailed: 'protocol error'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/22/2004 05:35'!
rfbEncodingXCursor: updateHeader
	"Process a X11-style cursor update."

	| hotSpot extent cursor mask cursorExtent realCursor realMask |
	hotSpot _ updateHeader cursorHotSpot.
	extent _ updateHeader cursorExtent.
	cursorExtent _ extent + (7@0) // (8@1).
	socket receiveData: (RFBXCursorColoursHeader new).	"IGNORED."
	cursor _ Form extent: extent depth: 1.
	mask _ Form extent: extent depth: 1.
	self receiveCursorForm: cursor extent: cursorExtent.
	self receiveCursorForm: mask extent: cursorExtent.
	realCursor _ CursorWithMask extent: 16@16 depth: 1.
	realMask _ Form extent: 16@16 depth: 1.
	cursor displayOn: realCursor.
	mask displayOn: realMask.
	realCursor setMaskForm: realMask.
	realCursor offset: hotSpot negated.
	currentCursor _ realCursor.
	hasCursor ifTrue: [realCursor beCursor]! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/24/2004 04:05'!
rfbEncodingZRLE: updateHeader
	"Process a zlib run-length encoding update."

	| length updateBounds bytes form |
	updateBounds _ updateHeader bounds.
	length _ (socket receiveData: RFBZRLEHeader new) length.
	bytes _ socket receiveData: (ByteArray new: length).
	zlibStream isNil
		ifTrue: [(zlibStream _ RFBZLibReadStream on: bytes)
					getPixel: socket getPixel getCPixel: socket getCPixel]
		ifFalse: [zlibStream continueOn: bytes].
	form _ RFBClientForm extent: updateBounds extent depth: serverFormat bitsPerPixel.
	form zrleDecode: (0@0 extent: updateBounds extent)
		from: zlibStream
		for: nil.
	self display: form on: image in: updateBounds.
	FastUpdate ifFalse: [Processor yield]! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:56'!
rfbEncodingZlib: updateHeader
	"Process a zlib encoding update."

	self log: 'rfbEncodingZlib: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'updating' stamp: 'ikp 3/21/2004 04:57'!
rfbEncodingZlibHex: updateHeader
	"Process a zlib hextile encoding update."

	self log: 'rfbEncodingZlibHex: ', updateHeader printString.
	self connectionFailed: 'unimplemented'! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/23/2004 11:53'!
blueButtonDown: anEvent
	"Override to avoid halo."

	self mouseDown: anEvent.
	^true! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/23/2004 11:52'!
blueButtonUp: anEvent
	"Override to avoid halo."

	self mouseUp: anEvent.
	^true! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/22/2004 09:57'!
keyDown: anEvent
	"Note: this event should be followed by a corresponding keyStroke, so we ignore the key value."

	self processModifiers: anEvent buttons! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/22/2004 10:09'!
keyStroke: anEvent
	"Send a key press to the server."

	self
		processModifiers: anEvent buttons;
		sendKeyEvent: (self encodeKey: anEvent keyValue) down: true;
		sendPeriodicUpdateRequest! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/22/2004 10:09'!
keyUp: anEvent
	"Send a key release to the server."

	self
		processModifiers: anEvent buttons;
		sendKeyEvent: (self encodeKey: anEvent keyValue) down: false! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/22/2004 11:17'!
mouseDown: anEvent
	"Send a mouse down event to the server."
	"Note: Morphic doesn't really give us any chance to turn off button mapping.  So Ctrl+button1 yields button2, rather than button1 with the control modifier on.  While this is hunk-dory for Squeak, it's kind of a bummer when you need the vt menu in an xterm..."

	self
		processModifiers: anEvent buttons;
		sendPointerEvent: anEvent buttons position: anEvent position! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/23/2004 03:01'!
mouseEnter: anEvent
	"The mouse just entered the window.  Remember that we now have control of the cursor.  If the server had previously installed a cursor in the receiver, set the Squeak cursor accordingly."

	hasCursor
		ifFalse:
			[savedCursor _ Cursor currentCursor.
			 hasCursor _ true.
			 currentCursor isNil ifFalse: [currentCursor beCursor]]! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/23/2004 03:01'!
mouseLeave: anEvent
	"The mouse has just left the window.  Note the fact that we no longer have control of the cursor.  If a cursor was saved on entry to the window, restore it now."

	hasCursor
		ifTrue:
			[hasCursor _ false.
			 savedCursor isNil ifFalse: [savedCursor beCursor]]! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/23/2004 03:05'!
mouseMove: evt
	"Send a motion event to the server."

	| inside |
	"Compensate for Morphic failing to send #mouseEnter:/Leave: correctly."
	inside _ scrollPane contentBounds containsPoint: evt position.
	inside & hasCursor not ifTrue: [self mouseEnter: evt].
	inside not & hasCursor ifTrue: [self mouseLeave: evt].
	self
		processModifiers: evt buttons;
		sendPointerEvent: evt buttons position: evt position! !

!RFBClient methodsFor: 'events' stamp: 'ikp 3/22/2004 05:52'!
mouseUp: anEvent
	"Send a button release event to the server."

	self mouseMove: anEvent! !

!RFBClient methodsFor: 'sending' stamp: 'ikp 3/21/2004 19:26'!
sendData: aMessage
	"Send aMessage to the server.  Assure mutually-exclusive access to the socket."

	sendLock critical:
		[[socket sendData: aMessage]
			on: Exception
			do: [self log: Exception printString; abort]]! !

!RFBClient methodsFor: 'receiving' stamp: 'ikp 3/22/2004 03:57'!
oldReceiveForm: aForm
	"Read the contents of aForm from the connection."

	| bytes |
	bytes _ ByteArray new: aForm bits byteSize.
	socket receiveData: bytes.
	(Form new hackBits: bytes) displayOn: (Form new hackBits: aForm bits).
	serverFormat swapBytesIfNeeded: aForm.
	^aForm! !

!RFBClient methodsFor: 'receiving' stamp: 'ikp 3/22/2004 05:35'!
receiveCursorForm: aForm extent: extent
	"Receive aForm from the connection."

	| w h bits bytes byteRow wordRow |
	w _ extent x.
	h _ extent y.
	bits _ aForm bits.
	bytes _ ByteArray new: w * h.
	socket receiveData: bytes.
	1 to: h do: [:y |
		byteRow _ y - 1 * w.
		wordRow _ y - 1 * 4.
		1 to: w do: [:x | bits byteAt: wordRow + x put: (bytes at: byteRow + x)]].
	^aForm! !

!RFBClient methodsFor: 'receiving' stamp: 'ikp 3/22/2004 05:24'!
receiveForm: aForm
	"Read the contents of aForm from the connection."

	| bytesPerLine bytesPerScan byte buf |
	bytesPerLine _ aForm width * aForm bytesPerPixel.
	bytesPerScan _ bytesPerLine + 3 bitAnd: -4.
	buf _ ByteArray new: bytesPerScan * aForm height.
	bytesPerLine == bytesPerScan
		ifTrue:
			[socket receiveData: buf]
		ifFalse:
			[byte _ 1.
			 1 to: aForm height do: [:y |
				socket receiveData: buf startingAt: byte count: bytesPerLine.
				byte _ byte + bytesPerScan]].
	(RFBForm new hackBits: buf) displayOn: (RFBForm new hackBits: aForm bits).
	serverFormat swapBytesIfNeeded: aForm.! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 11:21'!
abort
	"Abort the connection."

	self isConnected
		ifTrue:
			[socket closeAndDestroy.
			 socket _ nil.
			 zlibStream _ nil.
			 process ~~ Processor activeProcess ifTrue: [process terminate].
			 serverExtent _ 0@0.
			 self setExtent.
			 currentCursor _ nil.
			 hasCursor _ false.
			 savedCursor isNil ifFalse: [savedCursor beCursor].
			 savedCursor _ nil.
			 window setLabel: WindowLabel]! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/20/2004 23:53'!
aboutString
	"Answer the contents of the about window."

	^'
		*** RFBClient: a RFB/VNC viewer written entirely in Squeak. ***

  (If you don''t know what RFB and VNC are, go look at "http://www.realvnc.com"
  and/or "http://www.tightvnc.com".)

	Copyright (C) 2004 by Ian Piumarta
	All Rights Reserved.

	Released under the terms of: The Squeak License (what else did you expect? ;-)

	Send bug reports, suggestions, unsolicited gifts, etc., to: ian.piumarta@inria.fr

	Send complaints and other negative vibes to: nobody@localhost

  Enjoy!!'! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/20/2004 09:44'!
connectionFailed
	"The server failed the connection attempt in an orderly fashion.  Read the failure reason then inform the user that the connection attemp failed and bail."

	| message count |
	message _ socket receiveData: (RFBMessage new: 4).
	count _ message opcode.
	message _ socket receiveData: (String new: count).
	self connectionFailed: message! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/20/2004 23:05'!
connectionFailed: reason
	"Inform the user that the connection attemp failed, then bail."

	| message |
	message _ 'Connection failed: ', reason.
	self log: message; inform: message.
	self abort! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 07:19'!
display: sourceForm on: destForm in: destBounds
	"Display the sourceForm on the destForm within destBounds and invalidate the Display accordingly.  If fast updates are disabled then yield the Processor to give other interactive processes a chance to run."

	serverFormat display: sourceForm on: destForm at: destBounds origin.
	self invalidRect: destBounds.
	FastUpdate ifFalse: [Processor yield]! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/22/2004 04:23'!
encodeButtons: buttonMask
	"Answer a RFB button mask equivalent to the Squeak buttonMask."

	| buttons |
	buttons _ 0.
	#((1 2) (2 0) (4 -2)) do:
		[:maskShift |
		 buttons _ buttons bitOr: ((buttonMask bitAnd: maskShift first) bitShift: maskShift second)].
	^buttons! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 03:23'!
encodeKey: keyCode
	"Answer a key sym corresponding to the given Squeak keyCode.  Note: if the Control key is down we don't encode.  This ensures that C-l (ascii 12) remains C-l (keysym 12) rather than 'page down' (MacRoman 12) which would be 'Next' (keysym #ff56)."

	| keySym |
	(modifierState anyMask: CtrlKeyBit) ifFalse: [keySym _ KeySyms at: keyCode].
	keySym isNil ifTrue: [keySym _ keyCode].
	^keySym! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/20/2004 10:15'!
encryptChallenge: challenge with: password
	"Encrypt the 16-byte challenge with the given password.  Answer the encrypted challenge."

	| block |
	block _ ByteArray new: 8.
	1 to: (password size min: 8) do: [:i | block at: i put: (password at: i) asciiValue].
	password atAllPut: (Character value: 0).
	RFB3DES new
		encryptionKey: block;
		des: challenge to: challenge.
	block atAllPut: 0.
	^challenge! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/24/2004 05:36'!
helpString
	"Answer the contents of the help window."

	^
'Everything you need is on the window menu (the button at the top of the scrollbar).

*** Menu contents

** connect... / disconnect...

Depending on whether the viewer is already connected, this item lets you connect or disconnect.  When connecting, you will be asked for the IP address or name of the machine to which you want to connect.  If the machine requires a password, you will be asked for it too.  When disconnecting, you will be given a chance to change your mind.  (Disconnecting accidentally is no big deal anyway: you just connect again. ;-)

** options

Everything to do with viewer options.

* shared

If this is set then the viewer will request a shared connection.  If this is not set then the viewer will request exclusive access to the remote framebuffer.  Whether or not it gets that access depends on the server''s policy.

* local cursor

If this is enabled then the viewer will request that the server send cursor shape updates so that the viewer can track it locally.

* view-only

If this is enabled then the viewer will not send mouse or keyboard events to the server.

* 8-bit pixels

If this is enabled then the viewer will ask the server to send data using 8-bit deep pixels to reduce network traffic.

** encodings

Everything about selecting the encoding you''d like to use.

* auto

If enabled then the viewer will pick the most appropriate encoding for you.  Currently this means ''Raw'' encoding if the server is on the same machine, ''Hextile'' encoding otherwise.

* ZRLE
* Hextile
* CoRRE
* RRE
* RAW

If any of these are set then the viewer will ask the server to perform updates using that encoding.  Note that ZRLE currently has problems with some Windows VNC server implementations.  (Running it between two Squeak images works fine.)

Note that if you change the encoding while the viewer is connected, the new encoding preference will take effect immediately.  (Any other open viewers will not be affected.)

** performance

* fast update

If this is set then the viewer will consume more memory and will hog the CPU during updates to ensure the lowest possible update latencies.  In particular, while an update is in progress, no other userSchedulingPriority processes will be allowed to run.  If this option is not set then the viewer will attempt to minimise the amount of memory consumed during updates, and will yield the processor often (usually after each ''subrectangle'' in the update message).  This makes for slower update processing, and increased CPU usage while Morphic tries to catch up with screen updates at each yield, but does give other user-priority processes a chance to run.

** help...

You already know about.

** about...

Opens the Cheezoid About Window containing absolutely nothing of interest (other than an email address to which you can send bug reports or suggestions for improvements).

*** Bugs and caveat empori

* ZRLE is broken when talking to Windows servers.  I have no idea why.  The ZLibInflateStream in the image becomes hopelessly confused with the second update message that is received.  ZRLE works just fine between a Squeak server and a Unix client (or between Squeak server and Squeak viewer.

* Some of the menu options are currently unimplemented.  (The viewer was written for fun to occupy a rainy weekend and isn''t really meant to be a production-quality artefact.)  In particular, 8-bit pixels and view-only options are ignored when setting up the connection.

* The viewer currently always uses the server''s pixel format.  There should be an option to use the local pixel format instead.

* Some improvements to the way focus and mouse ''first clicks'' are handled are certainly warranted.

* The scroll bars sould vanish when the window is expanded to cover its entire contents.  The vertical scroll bar is stuck on the left too;  don''t blame me -- blame whoever wrote TwoWayScrollPane.'! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/20/2004 05:15'!
inATwoWayScrollPane
	"Answer a two-way scroll pane that allows the user to scroll the receiver in either direction."

	| widget |
	(widget _ TwoWayScrollPane new)
		extent: ((self width min: 300 max: 100) @ (self height min: 150 max: 100));
		borderWidth: 0.
	widget scroller addMorph: self.
	widget setScrollDeltas.
	widget color: self color darker.
	^widget! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 11:53'!
log: aMessage
	"Write aMessage to the client log."

	Transcript cr; show: aMessage! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 11:51'!
mousePoint: aPoint
	"Answer a sanitised mouse point: truncated and constrained to lie within the viewer's inner bounds."

	^((aPoint max: 0@0) min: image extent) truncated! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/22/2004 11:14'!
processModifiers: buttonMask
	"Check for modifier key press/release and fake the corresponding events."

	| prevState pressed released |
	prevState _ modifierState.
	modifierState _ buttonMask bitShift: -3.
	pressed _ (prevState bitXor: -1) bitAnd: modifierState.
	released _ (modifierState bitXor: -1) bitAnd: prevState.
	self sendModifiers: released down: false.
	self sendModifiers: pressed down: true! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 12:58'!
sendFullUpdateRequest
	"Send a full framebuffer update request for the visible area."

	self sendFramebufferUpdateRequest: scrollPane contentBounds incremental: false! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/23/2004 13:11'!
sendFullUpdateRequestForRegion: rectangles
	"Send a full framebuffer update request for the given rectangles."

	rectangles do:
		[:rect | self sendFramebufferUpdateRequest: rect incremental: false]! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/22/2004 10:12'!
sendModifiers: modifiers down: downFlag
	"Send fake key press/release events for modifier keys."

	| mask |
	mask _ 1.
	ModifierMap do:
		[:keySym |
		 (modifiers bitAnd: mask) ~~ 0
			ifTrue: [self sendKeyEvent: keySym down: downFlag].
		 mask _ mask bitShift: 1]! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/22/2004 10:22'!
sendPeriodicUpdateRequest
	"Send an incremental framebuffer update request for the visible area only if a protocol message has been received since the last such request."

	updateRequestPending
		ifTrue:
			[self sendUpdateRequest.
			 updateRequestPending _ false]! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/22/2004 10:21'!
sendUpdateRequest
	"Send an incremental framebuffer update request for the visible area."

	self sendFramebufferUpdateRequest: scrollPane contentBounds incremental: true! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/24/2004 04:40'!
setDefaultEncoding: encodingNumber
	"Set the default encoding.  If the client is connected, change the encoding in use for the session."

	DefaultEncoding _ encodingNumber.
	self isActive ifTrue: [self sendSetEncodings]! !

!RFBClient methodsFor: 'private' stamp: 'ikp 3/24/2004 01:42'!
setExtent
	"Set the extent of the server desktop."

	| form |
	serverFormat isNil
		ifFalse:
			[form _ RFBClientForm extent: serverExtent depth: serverFormat bitsPerPixel.
			 self image: form.
			 scrollPane setScrollDeltas.
			 self isActive ifTrue: [self sendFullUpdateRequest]]! !


!RFBClient class methodsFor: 'class initialisation' stamp: 'ikp 3/22/2004 10:30'!
initialiseConstants
	"RFBClient initialiseConstants"

	WindowLabel _ 'SqueakVNC'.

	ProtocolMajor _ 3.
	ProtocolMinor _ 7.

	MessageTypes _ #(
		"0"	rfbFramebufferUpdate
		"1"	rfbSetColourMapEntries
		"2"	rfbBell
		"3"	rfbServerCutText).

	RfbEncodingAuto _ -1.

	(Encodings _ Dictionary new)				"allow for gaps and LargeInts"
		"version 3.3"
		at: (RfbEncodingRaw		_ 0) put: #rfbEncodingRaw:;
		at: (RfbEncodingCopyRect	_ 1) put: #rfbEncodingCopyRect:;
		at: (RfbEncodingRRE			_ 2) put: #rfbEncodingRRE:;
		at: (RfbEncodingCoRRE		_ 4) put: #rfbEncodingCoRRE:;
		at: (RfbEncodingHextile		_ 5) put: #rfbEncodingHextile:;
		"tight vnc"
		at: (RfbEncodingZlib			_ 6) put: #rfbEncodingZlib:;
		at: (RfbEncodingTight		_ 7) put: #rfbEncodingTight:;
		at: (RfbEncodingZlibHex		_ 8) put: #rfbEncodingZlibHex:;
		"version 3.7"
		at: (RfbEncodingZRLE		_ 16) put: #rfbEncodingZRLE:;
		"special encodings"
		at: (RfbEncodingXCursor		_ 16rFFFFFF10) put: #rfbEncodingXCursor:;
		at: (RfbEncodingRichCursor	_ 16rFFFFFF11) put: #rfbEncodingRichCursor:;
		at: (RfbEncodingPointerPos	_ 16rFFFFFF18) put: #rfbEncodingPointerPos:;
		at: (RfbEncodingLastRect	_ 16rFFFFFF20) put: #rfbEncodingLastRect:! !

!RFBClient class methodsFor: 'class initialisation' stamp: 'ikp 3/22/2004 10:12'!
initialiseKeySyms
	"Initialise the tables used to map MacRoman key event codes to X11 keysyms, and local modifier key bits to server modifier bits."
	"RFBClient initialiseKeySyms"

	"The viewer sends 16-bit X11R6 keysyms.  There are hundreds of these.  The following are just the most common."
	KeySyms _ Array new: 256.
	#(	(16rFF08 8)		"bs"
		(16rFF09 9)		"tab"
		(16rFF0A 10)		"lf"
		(16rFF0D 13)		"cr"
		(16rFF1B 27)		"esc"
		(16rFF51 28)		"left"
		(16rFF52 30)		"up"
		(16rFF53 29)		"right"
		(16rFF54 31)		"down"
		(16rFF55 11)		"prior"
		(16rFF56 12)		"next"
		(16rFF57 4)		"end"
		(16rFFFF 127)	"del"
	) do: [:symKey | KeySyms at: symKey second put: symKey first].
	"The following works well for Apple keyboards.  Anyone who doesn't have an Apple keyboard may well suffer from a classic case of garbage-in, garbage-out"
	ShiftKeySym		_ 16rFFE1.	"shift_l"
	CtrlKeySym			_ 16rFFE3.	"control_l"
	CommandKeySym	_ 16rFFE7.	"meta_l"
	OptionKeySym		_ 16rFFE9.	"alt_l"

	(ModifierMap _ Array new: 5)
		at: 1 put: ShiftKeySym;
		at: 2 put: CtrlKeySym;
		at: 3 put: OptionKeySym;
		at: 4 put: CommandKeySym;
		at: 5 put: CommandKeySym! !

!RFBClient class methodsFor: 'class initialisation' stamp: 'ikp 3/23/2004 07:12'!
initialisePreferences
	"RFBClient initialisePreferences"

	DefaultEncoding _ RfbEncodingAuto.		"Automatically select encoding."
	Enable8Bit _ false.						"Default is local screen depth."
	EnableShared _ true.					"Default is to share connections."
	EnableExpandOnBell _ false.
	EnableExpandOnConnection _ false.		"For listen mode only."
	EnableViewOnly _ false.
	EnableXCursor _ true.
	FastUpdate _ false! !

!RFBClient class methodsFor: 'class initialisation' stamp: 'ikp 3/24/2004 05:53'!
initialize
	"RFBClient initialize"

	self
		initialiseConstants;
		initialisePreferences;
		initialiseKeySyms;
		registerInOpenMenu! !

!RFBClient class methodsFor: 'class initialisation' stamp: 'ikp 3/24/2004 05:53'!
unload
	"RFBClient is being removed from the image."

	self unregisterInOpenMenu! !

!RFBClient class methodsFor: 'instance creation' stamp: 'ikp 3/20/2004 05:02'!
new

	^super new initialise! !

!RFBClient class methodsFor: 'opening' stamp: 'ikp 3/23/2004 11:53'!
open
	"Open a RFBClient window."

	^self new open! !

!RFBClient class methodsFor: 'private' stamp: 'ikp 3/24/2004 05:59'!
registerInOpenMenu
	"Add RFBClient to the World open menu."
	"RFBClient registerInOpenMenu"

	(self confirm: 'Would you like to add the RFBClient to the World open menu?') ifFalse: [^self].
	Smalltalk at: #TheWorldMenu ifPresent:
		[:theWorldMenu |  theWorldMenu registerOpenCommand:
			{ 'RFB/VNC Viewer' . { RFBClient . #open } .
			  'Open a VNC viewer to access a remote Squeak desktop (or any other kind of VNC server).' }]
! !

!RFBClient class methodsFor: 'private' stamp: 'ikp 3/24/2004 05:56'!
unregisterInOpenMenu
	"Remove RFBClient from the World open menu."
	"RFBClient unregisterInOpenMenu"

	Smalltalk at: #TheWorldMenu ifPresent:
		[:theWorldMenu |
		 theWorldMenu unregisterOpenCommandWithReceiver: RFBClient].! !


!RFBDisplayScreen methodsFor: 'accessing' stamp: 'ikp 3/9/2004 20:13'!
rfbServer: server
	"Set the receiver's RFB server."

	rfbServer _ server.
	self setColourMap! !

!RFBDisplayScreen methodsFor: 'bordering' stamp: 'ikp 3/7/2004 20:26'!
border: rect width: borderWidth rule: rule fillColor: fillColor
	"Paint a border in the given rect and propagate the corresponding damage regions to all active remote viewers."

	| w h hx vx |
	super border: rect width: borderWidth rule: rule fillColor: fillColor.
	rfbServer isNil
		ifFalse:
		[w _ rect width.
		 h _ rect height.
		 hx _ w @ borderWidth.
		 vx _ borderWidth @ h.
		 rfbServer
			invalidate: (rect topLeft extent: hx);
			invalidate: (rect topLeft extent: vx);
			invalidate: (rect topRight - (borderWidth @ 0) extent: vx);
			invalidate: (rect bottomLeft - (0 @ borderWidth) extent: hx)]! !

!RFBDisplayScreen methodsFor: 'displaying' stamp: 'ikp 3/7/2004 20:27'!
forceToScreen: aRectangle
	"Force the contents of the Display within aRectangle to be drawn on the physical screen and in all remote viewers."

	super forceToScreen: aRectangle.
	rfbServer isNil ifFalse: [rfbServer invalidate: aRectangle]! !

!RFBDisplayScreen methodsFor: 'user interface' stamp: 'ikp 3/7/2004 20:25'!
beep
	"Emit an audible warning sound on the local Display and on all remote Displays."

	super beep.
	rfbServer isNil ifFalse: [rfbServer beep]! !

!RFBDisplayScreen methodsFor: 'user interface' stamp: 'ikp 3/7/2004 20:28'!
beepPrimitive
	"Emit an audible warning on the local Display and all remote viewers."

	super beepPrimitive.
	rfbServer isNil ifFalse: [rfbServer beep]! !

!RFBDisplayScreen methodsFor: 'private' stamp: 'ikp 3/9/2004 20:17'!
argb8888ColourMap
	"Answer a ColorMap that clears the alpha channel of all pixels to zero."

	^ColorMap shifts: #(0 0 0 0) masks: #(16rFFFFFF 0 0 0)! !

!RFBDisplayScreen methodsFor: 'private' stamp: 'ikp 3/9/2004 20:17'!
bgr233ColourMap
	"Answer a ColorMap that maps pixels from 32-bit ARGB8888 space into the BGR233 space used by viewers running in 8-bit 'true colour' mode."

	^ColorMap colors:
		((Color cachedColormapFrom: 8 to: 32) collect: [:pv |
			((((pv bitShift: -16-5)) bitAnd: 7) bitShift: 0)
			bitOr: (((((pv bitShift: -8-5)) bitAnd: 7) bitShift: 3)
			bitOr: ((((pv bitShift: -0-6)) bitAnd: 3) bitShift: 6))])! !

!RFBDisplayScreen methodsFor: 'private' stamp: 'ikp 3/9/2004 20:13'!
newDepthNoRestore: pixelDepth
	"Change the depth of the receiver, propagating the change to all remote viewers."

	super newDepthNoRestore: pixelDepth.
	self setColourMap.
	rfbServer isNil ifFalse: [rfbServer newDepth: pixelDepth]! !

!RFBDisplayScreen methodsFor: 'private' stamp: 'ikp 3/9/2004 20:22'!
setColourMap
	"Set the colourMap of the receiver based on its current depth.  If the depth is 32, use a colour map that clears the alpha channel (see #rgbContents: for the rationale).  If the depth is 8, use a colour map that converts Squeak's indexed pixel values into RFB's BGR233 pixel format."

	colourMap _ depth == 32
		ifTrue: [self argb8888ColourMap]
		ifFalse:
			[depth == 8
				ifTrue: [self bgr233ColourMap]]! !


!RFBEventSensor methodsFor: 'initialise-release' stamp: 'ikp 3/7/2004 20:28'!
initialize
	"Initialize the receiver."

	super initialize.
	eventMutex _ Semaphore forMutualExclusion! !

!RFBEventSensor methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:30'!
rfbServer: server
	"Set the receiver's RFBServer."

	rfbServer _ server! !

!RFBEventSensor methodsFor: 'copying' stamp: 'ikp 3/7/2004 20:30'!
copyFrom: other
	"Initialise the state of the receiver based on some other EventSensor object."

	1 to: other class instSize do: [:i | self instVarAt: i put: (other instVarAt: i)]! !

!RFBEventSensor methodsFor: 'copying' stamp: 'ikp 3/7/2004 20:29'!
copyTo: other
	"Copy the state of the receiver into another EventSensor object."

	1 to: other class instSize do: [:i | other instVarAt: i put: (self instVarAt: i)].
	^other! !

!RFBEventSensor methodsFor: 'cursor' stamp: 'ikp 3/7/2004 20:30'!
currentCursor: newCursor
	"Update the current cursor position.  Propagate the new cursor position to all remote viewers."

	super currentCursor: newCursor.
	rfbServer isNil ifFalse: [rfbServer currentCursor: newCursor]! !

!RFBEventSensor methodsFor: 'private' stamp: 'ikp 3/7/2004 20:29'!
processMouseEvent: evt
	"Process a mouse event caused by cursor motion.  Propagate the new mouse position to all remote viewers."

	| prev |
	prev _ mousePosition.
	super processMouseEvent: evt.
	rfbServer notNil & (prev ~= mousePosition)
		ifTrue: [rfbServer mousePosition: mousePosition]! !


!RFBForm methodsFor: 'initialise-release' stamp: 'ikp 3/7/2004 20:33'!
fromDisplay: aRectangle
	"Answer a RFBForm containing the contents of the Display within aRectangle."

	^(super fromDisplay: aRectangle) offset: aRectangle origin

"
(RFBForm fromDisplay: (100@100 corner: 200@200)) displayAt: 10@10
"! !

!RFBForm methodsFor: 'initialise-release' stamp: 'ikp 3/9/2004 19:56'!
initialiseBitBlts
	"Initialise the cached BitBlts."

	fill _ RFBBitBlt bitFillerToForm: self.! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:36'!
bounds
	"Answer the bounds of the original screen area from which the receiver was copied."

	^self boundingBox translateBy: offset! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:32'!
bytesPerPixel
	"Answer the number of bytes needed to represent one pixel in the receiver."

	^depth // 8! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/14/2004 17:04'!
dominantPixel
	"Answer the dominant (background) pixel in the receiver.
	Assumes: the receiver is 32 bits deep.
	Rationale: RFB/VNC server implementations traditionally (and stupidly) return the pixel at the origin for depth 16 or 32, or tally all pixels in the rectangle to find the predominant pixel when the depth is 8.  Both of these lose big when sending the initial screen, since: (1) the desktop background colour, at the origin, tends not to be the same as the window background colour covering most of the screen; and: (2) tallying pixel values in an 8-bit Form of any size, using BitBlt, involves enumerating a large tally array to find the maximum count.  Instead, since most non-background colour in the Squeak display is in narrow horizontal or vertical rectangles, we tally only a 1 pixel wide diagonal line from the origin.  This gives much better results than the traditional 'origin pixel' approach (since it is almost guaranteed to find the true backgound pixel) and speeds up RRE and CoRRE by a factor of three when sending a large update."

	| pixels line |
	pixels _ RFBPixelPopulation new.			"Should use Bag, but can't get at its raw contents."
	line _ 1.
	0 to: (height min: width) - 1 do: [:xy |
		pixels add: (bits at: line + xy).
		line _ line + width].
	^pixels dominantPixel					"*much* faster than 'aBag sortedCounts first key'"! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/23/2004 05:42'!
fill
	"Answer the BitBlt used to fill pixels in the receiver."

	^fill! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:38'!
format
	"Answer the RFBPixelFormat of the receiver's pixels."

	^format! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/9/2004 19:53'!
format: pixelFormat
	"Set the pixel format of the receiver."

	format _ pixelFormat! !

!RFBForm methodsFor: 'accessing' stamp: 'ikp 3/7/2004 20:39'!
width: w height: h
	"Set the width and height of the receiver without changing its bits."

	width _ w.
	height _ h.! !

!RFBForm methodsFor: 'copying' stamp: 'ikp 3/15/2004 18:10'!
applyColourMap: aColorMap
	"Apply aColorMap destructively to all the pixels in the receiver."

	(BitBlt toForm: self)
		sourceForm: self;
		combinationRule: Form over;
		width: width;
		height: height;
		colorMap: aColorMap;
		copyBits! !

!RFBForm methodsFor: 'copying' stamp: 'ikp 3/8/2004 02:22'!
subForm: bounds
	"Answer a copy of the portion of the receiver in bounds, at the same depth."

	| subForm |
	subForm _ RFBForm extent: bounds extent depth: depth.
	(BitBlt toForm: subForm)
		sourceForm: self;
		sourceOrigin: bounds origin;
		combinationRule: Form over;
		width: bounds width;
		height: bounds height;
		copyBits.
	^subForm! !

!RFBForm methodsFor: 'comparing' stamp: 'ikp 3/4/2004 12:21'!
isChangedFrom: aForm in: bounds
	"Answer whether the receiver differs from aForm within the given bounds."

	aForm == self ifTrue: [^false].
	(self extent ~= aForm extent or: [self depth ~= aForm depth])
		ifTrue: [self error: 'forms must be commensurate'].
	^self pvtChangedFrom: aForm in: bounds! !

!RFBForm methodsFor: 'drawing' stamp: 'ikp 3/9/2004 19:54'!
fill: aRectangle fillPixel: aPixel
	"Fill the region covered by aRectangle in the receiver with aPixel."

	fill pixelsIn: aRectangle put: aPixel! !

!RFBForm methodsFor: 'encoding-rre' stamp: 'ikp 3/8/2004 02:20'!
rreSubrectEncodeOn: encodedStream
	"The receiver is a Form in viewer byte order and depth, of arbitrary size.  Encode the contents on encodedStream using rise and run-length (RRE) encoding."

	| rawSize subrectHeader backgroundPixel subForm |
	rawSize _ bits byteSize.
	subrectHeader _ RFBRectangle new.
	subForm _ self pixelFormIn: self boundingBox.
	backgroundPixel _ subForm dominantPixel.
	encodedStream nextPutPixel: backgroundPixel.
	^subForm
		rreSubrectsForBackgroundPixel: backgroundPixel
		doWithForegroundPixel:
			[:subrect :fg |
			 encodedStream nextPutPixel: fg; nextPutAll: (subrectHeader bounds: subrect).
			 encodedStream size >= rawSize ifTrue: [^-1]]! !

!RFBForm methodsFor: 'encoding-rre' stamp: 'ikp 3/9/2004 19:55'!
rreSubrectsForBackgroundPixel: backgroundPixel doWithForegroundPixel: subrectBlock
	"Enumerate the RRE (rise and run-length encoded) rectangles within the receiver.  For each rectangle, invoke subrectBlock with the rectangle and its foreground (solid) pixel as arguments.  Answer the number of RRE subrectangles found in the receiver."

	| line subrectCount foregroundPixel hy hyflag scan j i vx hx vy hw hh vw vh subrect |
	line _ 1.
	subrectCount _ 0.
	0 to: height - 1 do: [:y |
		0 to: width - 1 do: [:x |
			(foregroundPixel _ bits at: line + x) ~= backgroundPixel
				ifTrue:
					[hy _ y - 1.
					 hyflag _ true.
					 scan _ line.
					 j _ y.
					 [j < height and: [(bits at: scan + x) = foregroundPixel]]
						whileTrue:
							[i _ x.
							 [i < width and: [(bits at: scan + i) = foregroundPixel]]
								whileTrue: [i _ i + 1].
							 i _ i - 1.
							 j == y ifTrue: [vx _ hx _ i].
							 i < vx ifTrue: [vx _ i].
							 hyflag & (i >= hx)
								ifTrue: [hy _ hy + 1]
								ifFalse: [hyflag _ false].
							 j _ j + 1.
							 scan _ scan + width].
					vy _ j - 1.
					"Two possible subrects: (x,y,hx,hy) (x,y,vx,vy).  Choose the larger."
					hw _ hx - x + 1.  hh _ hy - y + 1.
					vw _ vx - x + 1.  vh _ vy - y + 1.
					subrect _ x@y extent: (((hw*hh) > (vw*vh)) ifTrue: [hw@hh] ifFalse: [vw@vh]).
					subrectBlock value: subrect value: foregroundPixel.
					subrectCount _ subrectCount + 1.
					"Mark subrect as done."
					self fill: subrect fillPixel: backgroundPixel]].
		line _ line + width].
	^subrectCount! !

!RFBForm methodsFor: 'encoding-corre' stamp: 'ikp 3/8/2004 20:03'!
correSubrectEncodeIn: bounds on: stream
	"Encode the region in the receiver covered by the gicen bounds onto the stream using CoRRE encoding."

	| maxSize backgroundPixel subrectHeader subForm |
	maxSize _ bounds area * self bytesPerPixel.
	subForm _ self pixelFormIn: bounds.
	backgroundPixel _ subForm dominantPixel.
"self tallyPixel: backgroundPixel."
	stream nextPutPixel: backgroundPixel.
	subrectHeader _ RFBCoRRERectangle new.
	^subForm
		rreSubrectsForBackgroundPixel: backgroundPixel
		doWithForegroundPixel:
			[:subrect :fg |
"self tallyPixel: fg."
			 stream
				nextPutPixel: fg;
				nextPutAll: (subrectHeader bounds: subrect).
			 stream size < maxSize
				ifFalse: [^-1]]! !

!RFBForm methodsFor: 'encoding-hextile' stamp: 'ikp 3/8/2004 02:21'!
hextileColours
	"The receiver is a 16x16 pixel Form of depth 32 in viewer byte order.  Answer an Array of size 4 containing: (1) true if the Form is monochrome (or solid), false otherwise; (2) true if the Form is solid (contains a single colour), false otherwise; (3) the background (dominant) pixel; (4) the foreground (first pixel different from the background)."

	| tally1 tally2 colour1 colour2 |
	tally1 _ tally2 _ 0.
	bits do: [:pixel |
		tally1 == 0 ifTrue: [colour1 _ pixel].
		pixel = colour1
			ifTrue: [tally1 _ tally1 + 1]
			ifFalse:
				[tally2 == 0 ifTrue: [colour2 _ pixel].
				 pixel = colour2
					ifTrue: [tally2 _ tally2 + 1]
					ifFalse: [^Array		"monochrome solid background foreground"
								with: false
								with: false
								with: (tally1 > tally2 ifTrue: [colour1] ifFalse: [colour2])
								with: (tally1 > tally2 ifTrue: [colour2] ifFalse: [colour1])]]].
	^Array
		with: true
		with: colour2 == nil
		with: (tally1 > tally2 ifTrue: [colour1] ifFalse: [colour2])
		with: (tally1 > tally2 ifTrue: [colour2] ifFalse: [colour1])


"
| f |
f _ RFBForm fromUser.
f hextileColours
"! !

!RFBForm methodsFor: 'encoding-hextile' stamp: 'ikp 3/15/2004 18:02'!
hextileEncodeOn: stream forClient: rfbClient
	"Encode the contents of the receiver on rfbClient using Hextile encoding."

	| w h flags rect colours mono solid newBg newFg validBg validFg bg fg flagsPosition subForm bpp |
	bpp _ self bytesPerPixel.
	bg _ fg _ nil.
	validBg _ validFg _ false.
	0 to: height - 1 by: 16 do: [:y |
		0 to: width - 1 by: 16 do: [:x |
			w _ h _ 16.
			width - x < 16 ifTrue: [w _ width - x].
			height - y < 16 ifTrue: [h _ height - y].
			flagsPosition _ stream size.
			stream nextPut: (flags _ 0).
			rect _ x@y extent: w@h.
			subForm _ self pixelFormIn: rect.
			colours _ subForm hextileColours.
			mono _ colours at: 1.
			solid _ colours at: 2.
			newBg _ colours at: 3.
			newFg _ colours at: 4.
			(validBg not or: [newBg ~~ bg])
				ifTrue:
					[validBg _ true.
					 bg _ newBg.
					 flags _ flags bitOr: RfbHextileBackgroundSpecified.
					 stream nextPutPixel: bg].
			solid
				ifFalse:
					[flags _ flags bitOr: RfbHextileAnySubrects.
					 mono
						ifTrue:
							[(validFg not or: [newFg ~~ fg])
								ifTrue:
									[validFg _ true.
									 fg _ newFg.
									 flags _ flags bitOr: RfbHextileForegroundSpecified.
									 stream nextPutPixel: fg]]
						ifFalse:
							[validFg _ false.
							 flags _ flags bitOr: RfbHextileSubrectsColoured].
					 (subForm hextileSubrectEncodeOn: stream
								bg: bg fg: fg mono: mono
								bytesPerPixel: bpp) < 0
						ifTrue:
							[validBg _ validFg _ false.
							 stream
								resetTo: flagsPosition;
								nextPut: (flags _ RfbHextileRaw);
							 	nextPutForm: self in: rect]].
			 stream at: flagsPosition put: flags].
		stream size > rfbClient maximumTransmissionUnit
			ifTrue:
				[rfbClient sendStream: stream.
				 stream resetContents]].
	rfbClient sendStream: stream! !

!RFBForm methodsFor: 'encoding-hextile' stamp: 'ikp 3/7/2004 20:41'!
hextileSubrectEncodeOn: stream bg: bg fg: fg mono: mono bytesPerPixel: bpp
	"The receiver is a 16x16 Hextile subrectangle in viewer format, requiring bpp byytes per pixel, and containing 2 (iff mono is true) or more distinct pixel values.  Write its encoding onto the stream using the specified background and foreground pixels."

	| initialPosition subrectCount encodedLength maxLength |
	initialPosition _ stream size.
	stream nextPut: (subrectCount _ 0).
	encodedLength _ 1.
	maxLength _ width * height * bpp.
	subrectCount _ self
		rreSubrectsForBackgroundPixel: bg
		doWithForegroundPixel:
			[:subrect :foregroundPixel |
			 encodedLength _ encodedLength + (mono ifTrue: [2] ifFalse: [bpp + 2]).
			 encodedLength < maxLength ifFalse: [^-1].
			 mono ifFalse: [stream nextPutPixel: foregroundPixel].
			 stream
				nextPut: ((subrect left bitShift: 4) bitOr: subrect top);
				nextPut: ((subrect width - 1 bitShift: 4) bitOr: subrect height - 1)].
	stream at: initialPosition put: subrectCount.
	^subrectCount! !

!RFBForm methodsFor: 'encoding-zrle' stamp: 'ikp 3/16/2004 19:29'!
zrleEncodeOn: aStream
	"Encode the contents of the receiver on aStream for rfbClient using ZRLE encoding."

	| th tw |
	0 to: height - 1 by: RfbZrleTileHeight do:
		[:ty |
		 th _ RfbZrleTileHeight.
		 th > (height - ty) ifTrue: [th _ height - ty].
		 0 to: width - 1 by: RfbZrleTileWidth do:
			[:tx |
			 tw _ RfbZrleTileWidth.
			 tw > (width - tx) ifTrue: [tw _ width - tx].
			 (self pixelFormIn: (tx@ty extent: tw@th))
				zrleEncodeTileOn: aStream]]! !

!RFBForm methodsFor: 'encoding-zrle' stamp: 'ikp 3/24/2004 03:53'!
zrleEncodeTileOn: aStream
	"Encode the contents of the receiver on aStream for rfbClient using ZRLE encoding.  Assumes: the receiver is depth 32, regardless of the 'depth' of each pixel value stored in its Bitmap."

	| palette runs singlePixels ptr end pix usePalette estimatedBytes plainRleBytes useRle paletteRleBytes packedBytes runStart len index bppp nbits byte eol bpcp |
	palette _ RFBPalette new.
	bpcp _ aStream bytesPerCompressedPixel.
	"Built the palette and count the number of single pixels and runs."
	runs _ 0.
	singlePixels _ 0.
	ptr _ 1.
	end _ bits size + 1.
	[ptr < end]
		whileTrue:
			[pix _ bits at: ptr.
			 ((ptr _ ptr + 1) == end or: [pix ~= (bits at: ptr)])
				ifTrue: [singlePixels _ singlePixels + 1]
				ifFalse:
					[[(ptr _ ptr + 1) < end and: [(bits at: ptr) = pix]] whileTrue.
					 runs _ runs + 1].
			 palette insert: pix].
	"Solid tile (palette contains only one pixel) is a special case."
	palette size == 1
		ifTrue:
			[^aStream
				nextPut: 1;
				nextPutCPixel: palette pixels first].
	"Determine whether to use RLE and/or the palette.  We do this by
	 estimating the number of uncompressed bytes that will be generated
	 and choosing the method that generates the fewest.  Of course, this
	 may not result in the fewest bytes after compression."
	usePalette _ false.
	estimatedBytes _ width * height * bpcp.		"Raw encoding size."
	plainRleBytes _ bpcp + 1 * (runs + singlePixels).
	(useRle _ plainRleBytes < estimatedBytes)
		ifTrue: [estimatedBytes _ plainRleBytes].
	palette size < 128
		ifTrue:
			[paletteRleBytes _ (bpcp * palette size) + (2 * runs) + singlePixels.
			 paletteRleBytes < estimatedBytes
				ifTrue:
					[useRle _ true.
					 usePalette _ true.
					 estimatedBytes _ paletteRleBytes].
			 palette size < 17
				ifTrue:
					[packedBytes _ bpcp * palette size
						+ (width * height * (RfbZrleBitsPerPackedPixel at: palette size) // 8).
			 packedBytes < estimatedBytes
				ifTrue:
					[useRle _ false.
					 usePalette _ true.
					 estimatedBytes _ packedBytes]]].
	usePalette ifFalse: [palette size: 0].

	aStream nextPut: ((useRle ifTrue: [128] ifFalse: [0]) bitOr: palette size).
	1 to: palette size do: [:i | aStream nextPutCPixel: (palette pixels at: i)].
	useRle
		ifTrue:
			[ptr _ 1.
			 end _ 1 + (width * height).
			 [ptr < end]
				whileTrue:
					[runStart _ ptr.
					 pix _ bits at: ptr.
					 ptr _ ptr + 1.
					 [ptr < end and: [(bits at: ptr) = pix]] whileTrue: [ptr _ ptr + 1].
					 len _ ptr - runStart.
					 len <= 2 & usePalette
						ifTrue:
							[index _ palette lookup: pix.
							 len == 2 ifTrue: [aStream nextPut: index].
							 aStream nextPut: index]
						ifFalse:
							[usePalette
								ifTrue:
									[index _ palette lookup: pix.
									 aStream nextPut: (index bitOr: 128)]
								ifFalse:
									[aStream nextPutCPixel: pix].
							 len _ len - 1.
							 [len >= 255]
								whileTrue:
									[aStream nextPut: 255.
									 len _ len - 255].
							 aStream nextPut: len]]]
		ifFalse:
			[usePalette
				ifTrue:
					[ptr _ 1.
					 bppp _ RfbZrleBitsPerPackedPixel at: palette size.
					 0 to: height - 1 do:
						[:i |
						 nbits _ 0.
						 byte _ 0.
						 eol _ ptr + width.
						 [ptr < eol]
							whileTrue:
								[pix _ bits at: ptr.
								 ptr _ ptr + 1.
								 index _ palette lookup: pix.
								 byte _ (byte bitShift: bppp) bitOr: index.
								 nbits _ nbits + bppp.
								 nbits >= 8
									ifTrue:
										[aStream nextPut: byte.
										 nbits _ byte _ 0]].
						 nbits > 0
							ifTrue:
								[byte _ byte bitShift: 8 - nbits.
								 aStream nextPut: byte]]]
				ifFalse:	"raw"
					[bits do: [:pixel | aStream nextPutCPixel: pixel]]]! !

!RFBForm methodsFor: 'fileIn/Out' stamp: 'ikp 3/7/2004 20:33'!
hibernate
	"Put the receiver to sleep before storing an image snapshot.  Avoid hibernating the numerous small cached Forms within the RFB server implementation."

	bits size > 32 ifTrue: [super hibernate]! !

!RFBForm methodsFor: 'private' stamp: 'ikp 3/14/2004 18:45'!
pixelFormIn: bounds
	"Answer a Form containing contiguous 32-bit pixel values in the area of the receiver covered by the given bounds."

	| form w h cmap |
	w _ bounds width.
	h _ bounds height.
	cmap _ depth == 16 ifTrue: [IdentityMap16].
	(BitBlt toForm: (form _ RFBForm extent: w@h depth: 32))
		sourceForm: self;
		sourceOrigin: bounds origin;
		combinationRule: Form over;
		destX: 0 destY: 0 width: w height: h;
		colorMap: cmap;
		copyBits.
	^form! !

!RFBForm methodsFor: 'private' stamp: 'ikp 3/4/2004 12:47'!
pvtChangedFrom: aForm in: bounds
	"Answer whether the receiver differs from aForm within the given bounds.  Assume that aForm is commesurate with the receiver."

	| scale source dest l w t extent |
	depth > 8
		ifTrue:
			[scale _ self depth // 8.
			 extent _ width * scale @ height.
			 source _ Form extent: extent depth: 8 bits: bits.
			 dest _ Form extent: extent depth: 8 bits: aForm bits]
		ifFalse:
			[scale _ 1.
			 source _ self.
			 dest _ aForm].
	l _ bounds left * scale.
	w _ bounds width * scale.
	t _ bounds top.
	^0 ~~ ((BitBlt toForm: dest)
			sourceForm: source;
			sourceX: l;
			sourceY: t;
			combinationRule: 32;
			destX: l destY: t width: w height: bounds height;
			copyBits)! !

!RFBForm methodsFor: 'private' stamp: 'ikp 3/7/2004 20:32'!
setExtent: extent depth: bitDepth
	"Set the extent and depth of the receiver."

	super setExtent: extent depth: bitDepth.
	self initialiseBitBlts! !


!OldRFBDamageRecorder methodsFor: 'initialise-release' stamp: 'ikp 2/29/2004 20:00'!
colourMapForDeltaOfDepth: d

	| colours |
	colours _ (WordArray new: 256) atAllPut: 1; at: 1 put: 0; yourself.
	d == 8 ifTrue: [^ColorMap
						colors: colours].
	d == 16 ifTrue: [^ColorMap
						shifts: #(-8 0 0 0)
						masks: #(16rFF00 16r00FF 0 0)
						colors: colours].
	d == 32 	ifTrue: [^ColorMap
						shifts: #(-16 -8 0 0)
						masks: #(16rFF0000 16r00FF00 16r0000FF 0)
						colors: colours].
	^self error: 'Ian is confused'! !

!OldRFBDamageRecorder methodsFor: 'initialise-release' stamp: 'ikp 3/2/2004 05:16'!
setCache: aForm

	cachedForm _ aForm contentsOfArea: aForm boundingBox.
	deltaBlt _ (RFBBitBlt toForm: cachedForm)
		combinationRule: Form reverse.
	depthBlt _ (RFBBitBlt toForm: self)
		destRect: self boundingBox;
		sourceForm: cachedForm;
		combinationRule: Form over;
		colorMap: (self colourMapForDeltaOfDepth: aForm depth).
	foldBlt _ (RFBBitBlt toForm: self)
		sourceForm: self;
		combinationRule: Form under.
	updateBlt _ (RFBBitBlt toForm: cachedForm)
		combinationRule: Form over! !

!OldRFBDamageRecorder methodsFor: 'damage filter' stamp: 'ikp 3/2/2004 05:02'!
computeDamage: aForm in: bounds

	deltaBlt sourceForm: aForm sourceAndDestRect: bounds; copyBits.
	depthBlt clipRect: bounds; copyBits.
	updateBlt sourceForm: aForm sourceAndDestRect: bounds; copyBits

"
| f d |
f _ RFBForm fromDisplay: (0@0 corner: 100@100).
d _ RFBDamageRecorder forForm: f.
f fill: (40@40 corner: 48@48) fillColor: Color red.
f display.  (Delay forSeconds: 1) wait.
d computeDamage: f in: (f boundingBox insetBy: 20).
d display.  (Delay forSeconds: 1) wait.
Display restore.
^d
"! !

!OldRFBDamageRecorder methodsFor: 'damage filter' stamp: 'ikp 3/2/2004 05:21'!
testDamage: aForm in: bounds

	^self
		computeDamage: aForm in: bounds;
		validateDamageIn: bounds



"
| d1 d2 |
d1 _ RFBDamageRecorder forDisplay.
d2 _ OldRFBDamageRecorder forDisplay.
^Array
	with: (Time millisecondsToRun: [d1 testDamage: Display in: Display boundingBox])
	with: (Time millisecondsToRun: [d2 testDamage: Display in: Display boundingBox])
"


"
| f d l t n |
n _ 128.
f _ RFBForm fromDisplay: Display boundingBox.
d _ RFBDamageRecorder forForm: f.
f fill: (200@200 corner: 600@600) fillColor: Color red.
l _ OrderedCollection new.
MessageTally spyOn: [t _ Time millisecondsToRun: [
0 to: f height - n by: n do: [:y | 0 to: f width - n by: n do: [:x |
	(d testDamage: f in: (x@y extent: n@n))
		ifTrue: [l add: x@y]]].
]].
^Array with: t with: l
"
"
| f d l |
f _ RFBForm fromDisplay: (0@0 extent: 64@64).
d _ RFBDamageRecorder forForm: f.
0 to: 20 do: [:yy | Smalltalk beepPrimitive.
0 to: 20 do: [:xx |
1 to: 8 do: [:n |
	f colorAt: xx@yy put: ((f colorAt: xx@yy) negated).
	l _ OrderedCollection new.
	0 to: f height - n by: n do: [:y | 0 to: f width - n by: n do: [:x |
	(d testDamage: f in: (x@y extent: n@n))
		ifTrue: [l add: x@y]]].
	l size ~= 1 ifTrue: [self error: 'oops']]]].
"
! !

!OldRFBDamageRecorder methodsFor: 'damage filter' stamp: 'ikp 3/1/2004 05:33'!
validateDamageIn: bounds
	"Repeatedly fold the bounded area in half, combining pixels with an inclusive or, until only one pixel remains.  Answer whether the remaining pixel is nonzero, which will be the case unless every pixel in the area was initially zero."

	| origin x y dd d |
	origin _ bounds origin.
	x _ origin x.
	y _ origin y.
	"first reduce to a single line"
	foldBlt sourceAndDestRect: bounds.
	dd _ bounds height.
	[dd > 1]
		whileTrue:
			[d _ dd + 1 // 2.
			 foldBlt sourceY: y + dd - d height: d; copyBits.
			 dd _ d].
	"then reduce to a single pixel"
	foldBlt sourceY: y height: 1.
	dd _ bounds width.
	[dd > 1]
		whileTrue:
			[d _ dd + 1 // 2.
			 foldBlt sourceX: x + dd - d width: d; copyBits.
			 dd _ d].
	^(self pixelAt: origin) ~~ 0! !

!OldRFBDamageRecorder methodsFor: 'damage regions' stamp: 'ikp 3/1/2004 05:22'!
coalesceDamage: rects

	^self coalesceSortedDamage:
		(rects asSortedCollection: [:r :s | r top == s top
											ifTrue: [r left < s left]
											ifFalse: [r top < s top]])
			asOrderedCollection




"
RFBDamageRecorder new coalesceDamage: (OrderedCollection new).

RFBDamageRecorder new coalesceDamage: (OrderedCollection new
	add: (1@1 extent: 1@1);
	yourself).

RFBDamageRecorder new coalesceDamage: (OrderedCollection new
	add: (1@1 extent: 1@1);
	add: (2@1 extent: 1@1);
	yourself).

RFBDamageRecorder new coalesceDamage: (OrderedCollection new
	add: (1@1 extent: 1@1);
	add: (3@1 extent: 1@1);
	add: (2@1 extent: 1@1);
	yourself).

RFBDamageRecorder new coalesceDamage: (OrderedCollection new
	add: (1@1 extent: 1@1); add: (3@1 extent: 1@1); add: (2@1 extent: 1@1);
	add: (1@2 extent: 3@1);
	add: (1@3 extent: 1@3); add: (3@3 extent: 1@3); add: (2@3 extent: 1@3);
	yourself).

RFBDamageRecorder new coalesceDamage: (OrderedCollection new
	add: (1@1 extent: 1@1); add: (3@1 extent: 1@1); add: (2@1 extent: 1@1);
	add: (1@2 extent: 1@1); add: (2@2 extent: 1@1);
	yourself).

RFBDamageRecorder new coalesceDamage: (OrderedCollection new
	add: (1@1 extent: 1@1); add: (4@1 extent: 1@1); add: (2@1 extent: 1@1);
	add: (1@2 extent: 1@1); add: (2@2 extent: 1@1); add: (4@2 extent: 1@1); add: (5@2 extent: 1@1);
	yourself).

| r d s |
r _ Random new.
d _ OrderedCollection new.
1 to: 100 do: [:y | 1 to: 100 do: [:x | r next < 0.5 ifTrue: [d add: (x@y extent: 1@1)]]].
s _ RFBDamageRecorder new coalesceDamage: d.
^Array with: d with: s with: d size with: s size
"! !

!OldRFBDamageRecorder methodsFor: 'damage regions' stamp: 'ikp 3/1/2004 05:22'!
coalesceSortedDamage: rects

	| bands current coalesced |
	rects isEmpty ifTrue: [^rects].
	bands _ OrderedCollection new.
	current _ rects removeFirst.
	rects do: [:rect |
		(rect top == current top
		 and: [rect left == current right
		 and: [rect bottom == current bottom]])
			ifTrue:
				[current _ current origin corner: rect corner]
			ifFalse:
				[bands addLast: current.
				 current _ rect]].
	bands addLast: current.
	coalesced _ OrderedCollection new.
	current _ bands removeFirst.
	bands do: [:rect |
		(rect left == current left
		 and: [rect top == current bottom
		 and: [rect right == current right]])
			ifTrue:
				[current _ current origin corner: rect corner]
			ifFalse:
				[coalesced addLast: current.
				 current _ rect]].
	coalesced addLast: current.
	^coalesced! !

!OldRFBDamageRecorder methodsFor: 'damage regions' stamp: 'ikp 3/3/2004 03:32'!
getDamage: aForm inRect: rect

	| l r t b damage h w s |
	l _ rect left.
	r _ rect right.
	t _ rect top.
	b _ rect bottom.
	damage _ OrderedCollection new.
	self computeDamage: aForm in: rect.
	t to: b - 1 by: DamageHeight do: [:y |
		h _ y + DamageHeight >= b ifTrue: [b - y] ifFalse: [DamageHeight].
		l to: r - 1 by: DamageWidth do: [:x |
			w _ x + DamageWidth >= r ifTrue: [r - x] ifFalse: [DamageWidth].
			s _ x@y corner: (x+w)@(y+h).
			(self validateDamageIn: s) ifTrue: [damage addLast: s]]].
	^self coalesceSortedDamage: damage! !

!OldRFBDamageRecorder methodsFor: 'damage regions' stamp: 'ikp 3/1/2004 04:39'!
getDamage: aForm inRegion: rects

	| damage |
	damage _ OrderedCollection new.
	rects do: [:rect | damage addAll: (self getDamage: aForm inRect: rect)].
	^self coalesceDamage: damage! !


!RFBClientForm methodsFor: 'copying' stamp: 'ikp 3/23/2004 08:04'!
applyColourMap: aColorMap in: bounds
	"Apply aColorMap destructively to all the pixels in the receiver within bounds."

	(RFBBitBlt toForm: self)
		sourceForm: self;
		sourceAndDestRect: bounds;
		combinationRule: Form over;
		colorMap: aColorMap;
		copyBits! !

!RFBClientForm methodsFor: 'decoding-rre' stamp: 'ikp 3/23/2004 08:21'!
rreDecode: bounds from: aSocket for: client
	"Decode a CoRRE update from aSocket.  The receiver is of the correct depth and extent."

	| nSubrects pix subrect |
	nSubrects _ (aSocket receiveData: RFBRREHeader new) nSubrects.
	pix _ aSocket nextPixel.
	subrect _ RFBRectangle new.
	self fill pixelsIn: bounds put: pix.
	nSubrects
		timesRepeat:
			[pix _ aSocket nextPixel.
			 self fill pixelsIn: (aSocket receiveData: subrect) bounds put: pix]! !

!RFBClientForm methodsFor: 'decoding-corre' stamp: 'ikp 3/23/2004 08:26'!
correDecode: bounds from: aSocket for: client
	"Decode a CoRRE update from aSocket.  The receiver is of the correct depth and extent."

	| nSubrects pix subrect origin subBounds |
	nSubrects _ (aSocket receiveData: RFBRREHeader new) nSubrects.
	pix _ aSocket nextPixel.
	subrect _ RFBCoRRERectangle new.
	self fill pixelsIn: bounds put: pix.
	origin _ bounds origin.
	nSubrects
		timesRepeat:
			[pix _ aSocket nextPixel.
			 subBounds _ (aSocket receiveData: subrect) bounds translateBy: origin.
			 self fill pixelsIn: subBounds put: pix]! !

!RFBClientForm methodsFor: 'decoding-hextile' stamp: 'ikp 3/23/2004 07:05'!
hextileDecode: bounds from: aSocket for: client
	"Decode a hextile update from aSocket.  The receiver is of the correct depth and extent.  If client is nil then simply fill the receiver with the update.  If client is not nil then receive individual subrects and paint them on the receiver via the client."

	| w h subOrigin subExtent subBounds l r b bgFg |
	l _ bounds left.
	r _ bounds right.
	b _ bounds bottom.
	bgFg _ Array new: 2.
	bounds top to: b - 1 by: 16 do:
		[:y |
		 l to: r - 1 by: 16 do:
			[:x |
			 w _ r - x min: 16.
			 h _ b - y min: 16.
			 subOrigin _ x@y.
			 subExtent _ w@h.
			 subBounds _ subOrigin extent: subExtent.
			 client isNil
				ifTrue:	"Fast update: fill self."
					[self hextileSubrectDecode: subBounds from: aSocket with: bgFg]
				ifFalse:	"Slow update: display on self."
					[client
						display: ((RFBClientForm extent: subExtent depth: depth)
									hextileSubrectDecode: (0@0 corner: subExtent)
									from: aSocket
									with: bgFg)
					 	on: self
						in: subBounds]]]! !

!RFBClientForm methodsFor: 'decoding-hextile' stamp: 'ikp 3/23/2004 07:31'!
hextileSubrectDecode: bounds from: aSocket with: bgFg
	"Decode a hextile subrectangle from aSocket using the given foreground/background pixel values."

	| subEncoding nSubrects bg fg origin |
	subEncoding _ aSocket next.
	(subEncoding anyMask: RfbHextileRaw)
		ifTrue: [aSocket receiveForm: self in: bounds]
		ifFalse:
			[bg _ bgFg at: 1.
			 fg _ bgFg at: 2.
			 (subEncoding anyMask: RfbHextileBackgroundSpecified)
				ifTrue: [bg _ aSocket nextPixel].
			 self fill pixelsIn: bounds put: bg.
			 (subEncoding anyMask: RfbHextileForegroundSpecified)
				ifTrue: [fg _ aSocket nextPixel].
			 (subEncoding anyMask: RfbHextileAnySubrects)
				ifTrue:
					[origin _ bounds origin.
					 nSubrects _ aSocket next.
					 (subEncoding anyMask: RfbHextileSubrectsColoured)
						ifTrue:
							[nSubrects timesRepeat:
								[fg _ aSocket nextPixel.
								 self fill pixelsIn: (aSocket nextHextileBounds: origin) put: fg]]
						ifFalse:
							[nSubrects timesRepeat:
								[self fill pixelsIn: (aSocket nextHextileBounds: origin) put: fg]]].
			 bgFg
				at: 1 put: bg;
				at: 2 put: fg]! !

!RFBClientForm methodsFor: 'decoding-zrle' stamp: 'ikp 3/23/2004 10:17'!
bitsPerPackedPixel: paletteSize
	"Answer the number of bits required for each pixel index in a palette of the given size."

	^paletteSize > 16
		ifTrue: [8]
		ifFalse: [paletteSize > 4
			ifTrue: [4]
			ifFalse: [paletteSize > 2 ifTrue: [2] ifFalse: [1]]]! !

!RFBClientForm methodsFor: 'decoding-zrle' stamp: 'ikp 3/24/2004 03:16'!
zrleDecode: bounds from: aStream for: client
	"Decode a ZRLE update from the decompressed data on aStream.  The receiver is of the correct depth and extent."

	| l r t b th tw tile |
	l _ bounds left.
	r _ bounds right.
	t _ bounds top.
	b _ bounds bottom.
	t to: b - 1 by: RfbZrleTileHeight do:
		[:ty |
		 th _ b - ty min: RfbZrleTileHeight.
		 l to: r - 1 by: RfbZrleTileWidth do:
			[:tx |
			 tw _ r - tx min: RfbZrleTileWidth.
			 tile _ RFBClientForm extent: tw@th depth: 32.
			 tile zrleDecodeTileFrom: aStream for: client.
			 tile displayOn: self at: tx@ty]]! !

!RFBClientForm methodsFor: 'decoding-zrle' stamp: 'ikp 3/24/2004 03:57'!
zrleDecodeTileFrom: aStream for: client
	"Decode a ZRLE update tile from the decompressed data on aStream.  The receiver is depth 32 regardless of the bits per pixel in use."

	| mode rle palSize palette bppp mask nBits byte index ptr end pix len |
	mode _ aStream next.
	rle _ mode anyMask: 128.
	palSize _ mode bitAnd: 127.
	palette _ WordArray new: 128.
	1 to: palSize do: [:i | palette at: i put: aStream nextCPixel].
	palSize == 1
		ifTrue: [bits atAllPut: (palette at: 1)]
		ifFalse:
			[rle
				ifFalse:	"not rle"
					[palSize == 0
						ifTrue:	"raw pixels"
							[1 to: bits size do: [:i | bits at: i put: aStream nextCPixel]]
						ifFalse:	"packed pixels"
							[bppp _ self bitsPerPackedPixel: palSize.
							 mask _ (1 bitShift: bppp) - 1.
							 ptr _ 1.
							 1 to: height do:
								[:j |
								 nBits _ 0.
							 	 1 to: width do:
									[:i |
									 nBits == 0
									 ifTrue:
										[byte _ aStream next.
										 nBits _ -8].
									 nBits _ nBits + bppp.
									 index _ (byte bitShift: nBits) bitAnd: mask.
									 bits at: ptr put: (palette at: 1 + (index bitAnd: 127)).
									 ptr _ ptr + 1]]]]
				ifTrue:	"rle"
					[palSize == 0
						ifTrue:	"plain rle"
							[ptr _ 1.
							 end _ bits size.
							 [ptr <= end]
								whileTrue:
									[pix _ aStream nextCPixel.
									 len _ 1.
									 [byte _ aStream next.
									  len _ len + byte.
									  byte == 255] whileTrue.
									 len timesRepeat:
										[bits at: ptr put: pix.
										 ptr _ ptr + 1]]]
						ifFalse:	"palette rle"
							[ptr _ 1.
							 end _ bits size.
							 [ptr <= end]
								whileTrue:
									[index _ aStream next.
									 len _ 1.
									 (index anyMask: 128)
										ifTrue:
											[[byte _ aStream next.
											 len _ len + byte.
											 byte == 255] whileTrue].
									 pix _ palette at: 1 + (index bitAnd: 127).
									 len timesRepeat:
										[bits at: ptr put: pix.
										 ptr _ ptr + 1]]]]]! !


!RFBDamageRecorder methodsFor: 'initialise-release' stamp: 'ikp 3/19/2004 04:26'!
release
	"Drop references to anything potentially large."

	targetForm _ nil.
	bits _ nil! !

!RFBDamageRecorder methodsFor: 'testing' stamp: 'ikp 3/14/2004 17:05'!
isDamaged
	"Answer whether any damage is present in the entire Form covered by the receiver."

	^self isDamagedIn: self boundingBox! !

!RFBDamageRecorder methodsFor: 'testing' stamp: 'ikp 3/7/2004 20:23'!
isDamagedIn: bounds
	"Answer whether any damage exists in the receiver's Form within bounds."

	| damageFlag |
	(targetForm extent = self extent and: [targetForm bits size == bits size])
		ifFalse:
			[self setExtent: targetForm extent depth: targetForm depth].
	(damageFlag _ self pvtChangedFrom: targetForm in: bounds)
		ifTrue: [self updateDamageIn: bounds].
	^damageFlag





"
| c f g r |
c _ OrderedCollection new.
#(1 2 4 8 16 32) do: [:d |
	f _ RFBDamageRecorder on: (g _ Form extent: 100@100 depth: d).
	0 to: 90 by: 10 do: [:o |
		r _ o@o extent: 10@10.
		g fill: r fillColor: Color red.
		c add: d -> (r ->
			((f isDamagedIn: (49@49 corner: 51@51))
				-> (f isDamagedIn: (49@49 corner: 51@51))))]].
^String streamContents: [:s | c do: [:e | e printOn: s.  s cr]]
"! !

!RFBDamageRecorder methodsFor: 'private' stamp: 'ikp 3/8/2004 04:29'!
setTargetForm: aForm
	"Set the Form for which the receiver monitors damage."

	(BitBlt toForm: self)
        sourceForm: (targetForm _ aForm);
        combinationRule: Form over;
        destRect: self boundingBox;
        copyBits.! !

!RFBDamageRecorder methodsFor: 'private' stamp: 'ikp 3/7/2004 20:24'!
updateDamageIn: bounds
	"Update the receiver's cached copy of the targetForm with the given bounds, eliminating any damage that might have been there."

	(BitBlt toForm: self)
		sourceForm: targetForm;
		sourceOrigin: bounds origin;
		combinationRule: Form over;
		destRect: bounds;
		copyBits! !


!RFBDamageFilter methodsFor: 'damage containement' stamp: 'ikp 3/7/2004 20:21'!
coalesceDamage: rectangleList
	"See the comment in #coalesceSortedDamage:."

	^self coalesceSortedDamage:
		(rectangleList asSortedCollection:
			[:r :s | r top == s top
					ifTrue: [r left < s left]
					ifFalse: [r top < s top]])
		asOrderedCollection! !

!RFBDamageFilter methodsFor: 'damage containement' stamp: 'ikp 3/7/2004 20:20'!
coalesceSortedDamage: rectangleList
	"Answer a SequenceableCollection of Rectangles, covering the same overall area as those in rectangleList, but in which adjacent rectangles have been coalesced into maximal y-x bands."

	| mergedHorizontalRects currentRect mergedVerticalRects |
	rectangleList isEmpty ifTrue: [^rectangleList].
	mergedHorizontalRects _ OrderedCollection new.
	currentRect _ rectangleList removeFirst.
	rectangleList do: [:rect |
		(rect top == currentRect top
		 and: [rect left == currentRect right
		 and: [rect bottom == currentRect bottom]])
			ifTrue:
				[currentRect _ currentRect origin corner: rect corner]
			ifFalse:
				[mergedHorizontalRects addLast: currentRect.
				 currentRect _ rect]].
	mergedHorizontalRects addLast: currentRect.
	mergedVerticalRects _ OrderedCollection new.
	currentRect _ mergedHorizontalRects removeFirst.
	mergedHorizontalRects do: [:rect |
		(rect left == currentRect left
		 and: [rect top == currentRect bottom
		 and: [rect right == currentRect right]])
			ifTrue:
				[currentRect _ currentRect origin corner: rect corner]
			ifFalse:
				[mergedVerticalRects addLast: currentRect.
				 currentRect _ rect]].
	mergedVerticalRects addLast: currentRect.
	^mergedVerti