'From Squeak3.2 of 15 January 2002 [latest update: #4881] on 18 February 2003 at 11:07:41 pm'!
"Change Set:		telnet
Date:			16 October 2002
Author:			Ian Piumarta

This is a local and remote login client for Squeak comprising a protocol stack abstraction, endpoints for network (socket) and subprocess (pseudo tty) communication, a DFSA compiler (for taking the pain out of building stateful protocols), a partial-but-sufficient implementation of the RFC 854 telnet protocol, a glass teletype morph, an essentially complete VT102 terminal emulator (it passes the VT100/102 validation suite, except for wide and double-height characters and application keypad mode [trivial to implement, but I haven't got a keypad to test it with... ;-]) and the vast majority of an xterm emulator.  It comes with a class called PseudoTTY that implements the image side of Unix98 pseudo ttys (allowing the emulator to be connected to a subprocess that in turn believes itself to be connected to a real terminal -- can you say ``login shell''? ;-).  It's also turned into something of a `clickable' application: to fire it up, evaluate

	TeletypeWindow open

in a Workspace (or stick it in your `common expressions' menu) and then click on the window menu icon to start a shell or telnet session.

The terminal emulator now comes with its own font, a *real* TTY font that is infinitely more readable than Atlanta (and which has underscores and all the special graphics/line-drawing characters in all the right places).  It also supports colour correctly: adventurous GNU/Linux users might even like to try running `kbdconfig' in it (and comparing the result to what they see in a real xterm... <grin>!! ;-).  The only significant thing left to do is selection handling, copy and paste.

The telnet protocol has been tested with the GNU/Linux, Digital Unix (OSF/1) and Solaris telnet servers.  It requires only the standard Socket support to work and so should be FULLY FUNCTIONAL on Mac and Windows (assuming they implement the SO_OOBINLINE option in Socket>>setOption:value:).

The shell has been tested with bash and ash (the closest thing I have to a SysV shell) on GNU/Linux and Solaris (but there's no reason why it shouldn't work on any OS that supports Unix98 [aka XPG5 aka SUSv2] style PTYs).  It requires both AsynchFile and PseudoTTY plugins to work.  This means that the shell only works on Unix for the moment, until somebody gets round to porting the PseudoTTYPlugin to Windows and (ha ha) Mac.

Comments, suggestions and bug reports are welcome: ian.piumarta@inria.fr

Enjoy!!

(This changeset was supported by a generous quantity of Jaques Vabre coffee, thoroughly antisocial levels of Sergent Garcia's ``Un poquito quema'o'' and way too many Chesterfield Lights.  ÁSi no sanas hoy, sanar‡s ma–ana!!)"!

OrderedCollection subclass: #LayeredProtocol
	instanceVariableNames: 'properties '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!LayeredProtocol commentStamp: '<historical>' prior: 0!
I am a complete protocol implemented as a stack of subprotocols.  One end of the stack (the bottom or `tail') is usually an endpoint communicating with some remote host or process.  The other end (the top or `head') is either the point of communication for my client (which reads and writes only application-oriented data) or even the client itself.

I am created by sending my class the message #on: aSubProtocol.  You can then send me #push: aProtocol as many times as you like, to push aProtocol onto the head of my protocol stack.  When the stack is complete you must send me #install which tells me to finish creating the internal connections between each subprotocol in the stack.  Finally you send me #run which tells the entire protocol stack to start.!

LayeredProtocol class
	instanceVariableNames: ''!
Object subclass: #ProtocolLayer
	instanceVariableNames: 'session up down '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!ProtocolLayer commentStamp: '<historical>' prior: 0!
I am a single layer in a LayeredProtocol stack.  I pass information up and down the stack, possibly transforming it in the process.

Structure:
	down		(ProtocolLayer) My low protocol, one element closer to the "remote connection" end of the stack.
	up			(ProtocolLayer) My high protocol, one element closer to the user interface or other "local client".
	session		(LayeredProtocol) The entire collection of ProtocolLayers of which I am one.
!

ProtocolLayer subclass: #ProtocolAdaptor
	instanceVariableNames: 'upBlock downBlock flushBlock noteBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Protocols'!

!ProtocolAdaptor commentStamp: '<historical>' prior: 0!
I am a pluggable ProtocolLayer.  You can insert me anywhere in a LayeredProtocol stack.

Communication between protocol stack layers is accomplished using the following messages:

	upcall: datum					-- receive data from the protocol below me in the stack
	downcall: datum					-- receive data from the protocol above me
	flush							-- the protocol below me might become idle for a while
	note: aSymbol with: anObject	-- I am being informed that something "global" has happened

By default I am completely transparent.  In other words I react to the above messages as follows:

	upcall: datum					-- I pass datum on to the protocol above me
	downcall: dataum				-- I pass datum on to the protocol below me
	flush							-- I pass the message to the protocol above me
	note: sym with: obj				-- is ignored entirely

Any or all of these default reactions can be changed by installing blocks which I will execute in response to the above messages.  You install such blocks by sending me the following messages:

	upBlock: unaryBlock			-- evaluated on #up: passing datum as argument
	downBlock: unaryBlock			-- evaluated on #down: passing datum as argument
	flushBlock: aBlock				-- evaulated on #flush with no arguments
	noteBlock: binaryBlock			-- evaulated on #note:with: passing aSym and anObj as arguments

By now you've probably guess that my default behaviour is simply to install the following blocks when I am created:

	upBlock: [:datum | up upcall: datum]
	downBlock: [:datum | down downcall: datum]
	flushBlock: []
	noteBlock: [:aSymbol :anObject | ]

My class knows how to instantiate particular kinds of default behaviour in me, including:

	pass							-- the default (transparency)
	trace							-- prints each datum on the Transcript as it whizzes by
	reflect							-- bounces downward data back up the stack and vice-versa

Here's one example, possibly the shortest known means to create an "echo" server:

	(NetworkEndpoint socket: anAcceptedSocket) asProtocolStack
		push: ProtocolAdaptor reflect;
		install;
		run!

ProtocolAdaptor class
	instanceVariableNames: ''!
ProtocolLayer subclass: #ProtocolEndpoint
	instanceVariableNames: 'serverProcess '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Endpoints'!

!ProtocolEndpoint commentStamp: '<historical>' prior: 0!
I am an abstract endpoint for communication within a LayeredProtocol stack.  (I therefore expect to be the lowest element in that stack.)  I implement a server which waits for incoming data and then passes it up the stack for processing by higher protocol layers.  The actual reading of data from the remote entity must be implemented by my concrete subclasses.!

ProtocolEndpoint subclass: #NetworkEndpoint
	instanceVariableNames: 'socket '
	classVariableNames: 'InstanceList '
	poolDictionaries: ''
	category: 'Communications-Endpoints'!

!NetworkEndpoint commentStamp: '<historical>' prior: 0!
I am an endpoint for network communication.  I am also a ProtocolLayer and I therefore expect to be inserted as the lowest element in a LayeredProtocol stack.

Structure:

	socket			(Socket)	-- the socket on which I communicate.
!

NetworkEndpoint class
	instanceVariableNames: ''!
ProtocolEndpoint subclass: #ProcessEndpoint
	instanceVariableNames: 'pty command arguments '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Endpoints'!

!ProcessEndpoint commentStamp: '<historical>' prior: 0!
I am an endpoint for communication with another process.  I am also a ProtocolLayer and I therefore expect to be inserted as the lowest element in a LayeredProtocol stack.

Well, that's the official story anyway.  In fact I am happy to communicate with anything that talks through an AsyncFile.  It just so happens that one kind of AsyncFile is PsuedoTTY which can be connected to the stdin, stdout and stderr of a remote process.

Structure:

	pty			(PseudoTTY)	-- the asynchronous file with which I communicate.
!

ProcessEndpoint class
	instanceVariableNames: ''!
IdentityDictionary subclass: #ProtocolState
	instanceVariableNames: 'name default '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!ProtocolState commentStamp: '<historical>' prior: 0!
I am a single state within a cyclic graph of states.  My values are edges leading to another state in the graph.  If the edge has an action associated with it then I perform the method of that name in my client object, passing the object which stepped me as argument, before following the edge.

Structure:
 name		Symbol				-- my state's name
 keys		Object				-- the input tokens that cause me to step
 values		#(Symbol1 Symbol2)	-- an edge: the next state and a client action selector
 default		#(Symbol1 Symbol2)	-- the edge I follow if no key matches the stepping object

I am intended to be inserted somewhere in the middle of a LayeredProtocol stack.!

ProtocolState class
	instanceVariableNames: ''!
Object subclass: #ProtocolStateTransition
	instanceVariableNames: 'state action '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!ProtocolStateTransition commentStamp: '<historical>' prior: 0!
I am a transition to a new ProtocolState.  While making the transition I can perform some action association with the change from the old to the new state.!

ProtocolStateTransition class
	instanceVariableNames: ''!
Socket subclass: #SafeSocket
	instanceVariableNames: 'hostName '
	classVariableNames: 'InstanceList '
	poolDictionaries: ''
	category: 'Communications-Endpoints'!

!SafeSocket commentStamp: '<historical>' prior: 0!
I am a Socket that knows about the dangers of remaining open across snapshot.!

SafeSocket class
	instanceVariableNames: ''!
Morph subclass: #SimpleTextMorph
	instanceVariableNames: 'font fgMap bgMap pitch rv lineState cursorColour '
	classVariableNames: 'Background Background2 DefaultStyle Foreground Foreground2 '
	poolDictionaries: ''
	category: 'Communications-Terminal Emulation'!

!SimpleTextMorph commentStamp: '<historical>' prior: 0!
I display a string with optional foreground, background and emphasis changes.  I shouldn't really exist but StringMorph doesn't know how to change colour or emphasis in mid-run and cannot affect its background colour at all.  On the other hand, TextMorph does way too much and wants to take over keyboard and mouse input and a whole bunch of other useless stuff such as line wrapping.  I could have used Text as my underlying representation and reused TextMorph's scanner except that it works on paragraphs (not linear text) and can't change background colour anyway.  Ho hum.  Short of installing a whole bunch of new rendering methods in the various canvases to plass explicit background colour information, I guess I just have to do everything myself.  C'est la vie, I suppose.

	SimpleTextMorph example

Structure:
	font		StrikeFont		-- the font I render with (this had better be monospaced!!)
	pitch		SmallInteger	-- the width of a character in font
	string		String			-- my contents
	fgRuns		Array			-- foreground changes (should be RunArray)
	bgRuns		Array			-- background changes (ditto)
	emRuns		Array			-- emphasis changes (ditto)!

SimpleTextMorph class
	instanceVariableNames: ''!
Object subclass: #SimpleTextState
	instanceVariableNames: 'string stringSize fgRuns bgRuns emRuns cursorCol changed selection lastCol '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Terminal Emulation'!
SimpleTextState class
	instanceVariableNames: ''!
ProtocolLayer subclass: #StatefulProtocol
	instanceVariableNames: 'currentState client '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!StatefulProtocol commentStamp: '<historical>' prior: 0!
I am a ProtocolLayer.  I implement my protocol as a state machine, transitioning from one state to another according to patterns that I recognise in the data flowing through me.!

StatefulProtocol class
	instanceVariableNames: ''!
IdentityDictionary subclass: #StatefulProtocolDescription
	instanceVariableNames: 'initialState '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!StatefulProtocolDescription commentStamp: '<historical>' prior: 0!
I am a collection of ProtocolStates constituting a transition graph for a StatefulProtocol.  See my class side for some examples of how I construct state machine descriptions for you.

Note that before I can be used to drive a StatefulProtocol you *must* send me #compile.  I will answer the initial ProtocolState in the compiled transition graph.  (I will also complain if your protocol is broken. ;-)  You subsequently pass this ProtocolState as the argument to StatefulProtocol class>>initialState: in order to instantiate a new StatefulProtocol.

Structure:
 initialState		Symbol	-- the name of the initial (root) node in my transition graph!

StatefulProtocolDescription class
	instanceVariableNames: ''!
StatefulProtocol subclass: #StatefulProtocolTester
	instanceVariableNames: 'prefix '
	classVariableNames: 'States '
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!StatefulProtocolTester commentStamp: '<historical>' prior: 0!
I am a simple (but complete) state machine.  I recognise sequences of characters (with embedded numeric arguments for certain sequences) in strings.  I also print out what I'm doing on the Transcript so that you can see precisely how I work.

	StatefulProtocolTester test

Structure:
 prefix		SmallInteger	-- the numeric argument currently under contruction!

StatefulProtocolTester class
	instanceVariableNames: ''!
StatefulProtocolTester subclass: #StatefulProtocolTester2
	instanceVariableNames: 'e x xy xyz '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Abstract'!

!StatefulProtocolTester2 commentStamp: '<historical>' prior: 0!
I am just like StatefulProtocolTester except that I measure the throughput of the protocol as number of state transitions per second.

	StatefulProtocolTester2 test!

StatefulProtocolTester2 class
	instanceVariableNames: ''!
RectangleMorph subclass: #TeletypeMorph
	instanceVariableNames: 'inset font pitch skip rows cols lines savedLines savedLineLimit displayStart topLine bottomLine down x y fg bg em rv ec tabs useScrollbar scroll scrollFlop scrollRight scrollOn autoWrap reverseWrap autoLinefeed autoCR relativeOrigin insertMode showCursor session systemWindow running autoFlush smoothScroll steps metaSendsEscape deleteIsDel altScreenSwitch altScreenActive altScreenColours reverseVideo hasFocus mousePosition selectionStart selectionEnd selectionActive selection trackingSelection mouseControlsSelection keyboardControlsSelection scrollOnInput scrollOnOutput allow132 characterClasses cursorColour '
	classVariableNames: 'CharClass KeyboardControlsSelection MouseControlsSelection SaveTerminalSize SavedLineLimit TextCursor '
	poolDictionaries: ''
	category: 'Communications-Terminal Emulation'!

!TeletypeMorph commentStamp: '<historical>' prior: 0!
I am a glass teletype.  I accept raw input from some source (which I display without interpretation) and generate raw characters for some sink.

I implement sufficient cursor addressing and character attributes to provide terminal emulators with the necessary support to implement ANSI (ISO 6429) colours and emphasis (with the exception of blinking) and the full range of VT220-style cursor-based screen editing.  However, I make no attempt to interpret ASCII control characters nor ANSI, DEC (or any other) escape sequences.  This, like all other `cooked' interpratation of special characters, is left entirely to my source and sink (which will normally be the same instance of some terminal emulator, immediately below me in a protocol stack).

I am designed to be the head of a protocol stack.  For this reason I expect my source to send me #upcall: aCharacter (I am the high protocol for some emulator) and I pass keyboard events down to my sink by sending it #downcall: aCharacter (the sink is my low protocol).  Anybody can send me #delete which I will propagate to all members of my protocol stack as a #windowClosed note.  (This will normally cause any connected endpoints at the tail end of the stack to be disconnected and destroyed.)

	TeletypeMorph new openInWorld
!

TeletypeMorph class
	instanceVariableNames: ''!
SystemWindow subclass: #TeletypeWindow
	instanceVariableNames: 'tty windowTitle iconTitle '
	classVariableNames: 'AutoClose SaveTelnetOptions SaveTerminalMainOptions SaveTerminalSize SaveTerminalVTOptions Shortcuts TerminalType '
	poolDictionaries: ''
	category: 'Communications-Terminal Emulation'!

!TeletypeWindow commentStamp: '<historical>' prior: 0!
I am a kind of SystemWindow intended specifically for hosting a TeletypeMorph.  I provide connection-oriented menus, persistent preferences and menu-based access to my TeletypeMorphs options.!

TeletypeWindow class
	instanceVariableNames: ''!
StatefulProtocol subclass: #TelnetProtocol
	instanceVariableNames: 'debug dumpNetData dumpTermData doNAWS cols rows '
	classVariableNames: 'AO AYT Break Commands DataMark Debug Do Dont DumpNetData DumpTermData EC EL Echo EnvironmentOption ForwardX GoAhead IAC IP Is Linemode Logout NAWS NewEnvironment Nop Options RemoteFlowControl SB SE Send Status Subnegotiation SuppressGoAhead SuppressLocalEcho TerminalSpeed TerminalType Will Wont XDisplayLocation '
	poolDictionaries: ''
	category: 'Communications-Protocols'!

!TelnetProtocol commentStamp: '<historical>' prior: 0!
I am a ProtocolLayer implementing the telnet (RFC 854) protocol.  I expect to be inserted into a LayeredProtocol stack in which the endpoint is connected to a remote telnet server.  When I receive #run from the protocol stack I will begin negotiation with the remove server.  If the negotiation is successful, the protocol above me in the stack (or the client of the entire stack) will see an interactive login session.!

TelnetProtocol class
	instanceVariableNames: 'States '!
StatefulProtocol subclass: #VT102Emulator
	instanceVariableNames: 'arguments window trace mode keypadMode cursorState charMap g0Map g1Map keyMap '
	classVariableNames: 'CharsGR CharsUK CharsUS '
	poolDictionaries: ''
	category: 'Communications-Terminal Emulation'!

!VT102Emulator commentStamp: '<historical>' prior: 0!
I emulate a VT102 terminal.  The VT102 is an enhanced VT100 with additional screen editing functions, especially useful for full-screen editors (like Emacs) running over slow connections.

I expect to be inserted somewhere in the middle of a protocol stack.  My low procotol (usually some kind of remote login protocol) sends me #upcall: aCharacter to display aCharacter.  I filter out control sequences (sending appropriate messages to my window (usually a TeletypeMorph) to effect cursor movement, character attribute manipulation, screen editing and so on) or simply pass printing characters up to my high protocol (usually the same TeletypeMorph as my window) verbatim for display.  I accept keyboard input from my high protocol (again usually my window) which I pass down to my low protocol with conversion from Squeak keycodes to ANSI or DEC escape sequences representing cursor and other special keys.

I'm a subclass of Protocol, which is a subclass of StateMachine, since terminal emulation is simply a matter of recognising particular patterns (`escape sequences') in a stream of characters (as is any kind of `protocol').

I recognise the escape sequences as defined in: "VT102 Video Terminal User Guide", 3rd edition, Digital Equipment Corporation, February 1982, part number EK-VT102-UG-003.  When in VT52 mode I also recognise the escape sequences defined in "DECscope User's Manual", 1st edition, Digital Equipment Corporation, April 1976, part number EK-VT5X-OP-001.  (If you don't own copies of these historic documents then Shame On You!! ;-)!

VT102Emulator class
	instanceVariableNames: 'States '!
VT102Emulator subclass: #XtermEmulator
	instanceVariableNames: 'savedBuffer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Communications-Terminal Emulation'!

!XtermEmulator commentStamp: '<historical>' prior: 0!
I emulate a xterm terminal.  The xterm is a modern member of the DEC VT200 family with additional ANSI functions including support for ISO 6429 colour escape sequences.  I am particularly useful for full-screen programs that know how to use colour highlighting (such as Emacs version 21 and higher).

I inherit from VT102Emulator because I implement a proper superset of its capabilities.

See the class comments in my superclasses (VT102Emulator in particular) for further information on how to use me.!

XtermEmulator class
	instanceVariableNames: ''!

!BlockContext methodsFor: 'evaluating'!
value: arg1 value: arg2 value: arg3 value: arg4 value: arg5
	"Primitive. Evaluate the block represented by the receiver. Fail if the 
	block expects other than three arguments or if the block is already being 
	executed. Optional. See Object documentation whatIsAPrimitive."

	<primitive: 81>
	^self valueWithArguments: 
		(Array
			with: arg1
			with: arg2
			with: arg3
			with: arg4
			with: arg5)! !


!FormCanvas methodsFor: 'drawing-text'!
drawString: aString from: firstIndex to: lastIndex in: bounds font: fontOrNil color: c background: b
	| font portRect |
	port colorMap: nil.
	portRect _ port clipRect.
	port clipByX1: bounds left + origin x 
		y1: bounds top + origin y 
		x2: bounds right + origin x 
		y2: bounds bottom + origin y.
	font _ fontOrNil ifNil: [TextStyle defaultFont].
	port combinationRule: Form paint.
	font installOn: port
		foregroundColor: (self shadowColor ifNil:[c]) 
		backgroundColor: b.
	font displayString: aString asString on: port 
		from: firstIndex to: lastIndex at: (bounds topLeft + origin) kern: 0.
	port clipRect: portRect.! !


!LayeredProtocol methodsFor: 'initialize-release'!
initializeProperties

	properties _ IdentityDictionary new! !

!LayeredProtocol methodsFor: 'accessing'!
head
	"Answer the head of the stack."

	^self first! !

!LayeredProtocol methodsFor: 'accessing'!
pop
	"Remove the head of the stack."

	^self removeFirst! !

!LayeredProtocol methodsFor: 'accessing'!
propertyAt: aKey

	^properties at: aKey ifAbsent: []! !

!LayeredProtocol methodsFor: 'accessing'!
propertyAt: aKey ifAbsent: aBlock

	^properties at: aKey ifAbsent: aBlock! !

!LayeredProtocol methodsFor: 'accessing'!
propertyAt: aKey put: aValue

	^properties at: aKey put: aValue! !

!LayeredProtocol methodsFor: 'accessing'!
push: aProto
	"Push a new protocol onto the head of the stack."

	self addFirst: aProto! !

!LayeredProtocol methodsFor: 'accessing'!
tail
	"Answer the tail of the stack."

	^self last! !

!LayeredProtocol methodsFor: 'protocol'!
endpoint

	^self last! !

!LayeredProtocol methodsFor: 'protocol'!
install

	| prev |
	prev _ nil.
	self do: [:this |
		this session: self.
		prev isNil ifFalse: [this up: prev.  prev down: this].
		this install.
		prev _ this]! !

!LayeredProtocol methodsFor: 'protocol'!
isConnected

	^self endpoint isConnected! !

!LayeredProtocol methodsFor: 'protocol'!
note: aSymbol with: anObject
	"Inform my members that something has happened."

	self do: [:proto | proto note: aSymbol with: anObject]! !

!LayeredProtocol methodsFor: 'protocol'!
run

	self do: [:proto | proto run]! !

!LayeredProtocol methodsFor: 'private'!
addDown: proto

	^self addLast: proto! !

!LayeredProtocol methodsFor: 'private'!
addUp: proto

	^self addFirst: proto! !

!LayeredProtocol methodsFor: 'private'!
removeUp

	^self removeFirst! !


!LayeredProtocol class methodsFor: 'instance creation'!
new

	^super new initializeProperties! !

!LayeredProtocol class methodsFor: 'instance creation'!
on: proto

	^self new push: proto! !

!LayeredProtocol class methodsFor: 'examples'!
example
	"Send 42 down a stack and then reflect it back up."
	"LayeredProtocol example"

	(ProtocolAdaptor new reflect asProtocolStack
		push: ProtocolAdaptor new trace;
		push: ProtocolAdaptor new trace;
		push: (ProtocolAdaptor new trace
				upBlock: [:arg | Transcript cr; show: 'ping ' , arg printString]);
		install;
		run;
		first) downcall: 42! !

!LayeredProtocol class methodsFor: 'examples'!
example3
	"LayeredProtocol example3"
	"Glass teletype with local echo."

	^ProtocolAdaptor new localEcho asProtocolStack
		push:	TeletypeMorph new openInWorld;
		install;
		run! !


!ProtocolLayer methodsFor: 'accessing'!
down: protoLo

	down _ protoLo! !

!ProtocolLayer methodsFor: 'accessing'!
session

	^session! !

!ProtocolLayer methodsFor: 'accessing'!
session: aSession

	session _ aSession! !

!ProtocolLayer methodsFor: 'accessing'!
up: protoHi

	up _ protoHi! !

!ProtocolLayer methodsFor: 'testing'!
isConnected

	^false! !

!ProtocolLayer methodsFor: 'stack'!
asProtocolStack
	"Answer a new LayeredProtocol in which I am the lowest element."

	^LayeredProtocol on: self! !

!ProtocolLayer methodsFor: 'stack'!
downcall: anObject
	"Receive anObject from my high protocol.  The default behaviour is to pass it down unmodified to my low protocol (i.e., I am transparent)."

	down downcall: anObject! !

!ProtocolLayer methodsFor: 'stack'!
downcallAll: aCollection
	"Receive aCollection of data from my high protocol.  The default behaviour is to act as if each datum was received individually."

	aCollection do: [:elt | self downcall: elt]! !

!ProtocolLayer methodsFor: 'stack'!
flush
	"Inform my high protocol that we might be about to pause for a while."

	up flush! !

!ProtocolLayer methodsFor: 'stack'!
install
	"Perform any additional actions when creating the initial up/down connections between elements in the ProtocolStack."! !

!ProtocolLayer methodsFor: 'stack'!
passUp: anObject
	"Pass anObject up to my high protocol."

	up upcall: anObject! !

!ProtocolLayer methodsFor: 'stack'!
push: aProtocol
	"Push aProtocol on top of the receiver."

	^(LayeredProtocol on: self) push: aProtocol! !

!ProtocolLayer methodsFor: 'stack'!
run
	"Perform any additional actions when starting the protocol running (i.e., just before data transfer begins)."! !

!ProtocolLayer methodsFor: 'stack'!
upcall: anObject
	"Receive anObject from my low protocol.  Default is to pass it on to my high protocol unmodified (in other words, I am transparent)."

	up upcall: anObject! !

!ProtocolLayer methodsFor: 'stack'!
upcallAll: aCollection
	"Receive aCollection of data from my low protocol.  By default I act as if each datum had been received individually."

	aCollection do: [:b | self upcall: b]! !

!ProtocolLayer methodsFor: 'session'!
note: aSymbol with: anArgument
	"My session is informing me that something has happened.  By default I don't care about it."! !

!ProtocolLayer methodsFor: 'session'!
sessionNote: aSymbol
	"Tell my session that something has happened.  If I have no session then do nothing."

	session isNil ifFalse: [session note: aSymbol with: nil]! !

!ProtocolLayer methodsFor: 'session'!
sessionNote: aSymbol with: anArgument
	"Tell my session that something has happened.  If I have no session then do nothing."

	session isNil ifFalse: [session note: aSymbol with: anArgument]! !

!ProtocolLayer methodsFor: 'diagnostics'!
ttyCR

	self ttyMsg: String cr! !

!ProtocolLayer methodsFor: 'diagnostics'!
ttyMsg: aString

	aString withInternetLineEndings asByteArray do: [:b | up upcall: b].
	up flush! !

!ProtocolLayer methodsFor: 'diagnostics'!
ttyMsgCR: aString

	self ttyMsg: aString, String cr! !


!ProtocolAdaptor methodsFor: 'initialize-release'!
initialize

	upBlock _ [:arg | self notify: 'up ' , arg printString].
	downBlock _ [:arg | self notify: 'down ' , arg printString].
	flushBlock _ [].
	noteBlock _ [:s :a | ]! !

!ProtocolAdaptor methodsFor: 'canned protocols'!
localEcho
	"A reflect suitable for local echo on dumb ttys, when placed immediately below a TtyMorph, recognising a few of the ASCII control characters."

	| c |
	^self
		upBlock: [:arg | down downcall: arg];
		downBlock: [:arg | c _ arg bitAnd: 127.
			(c == 8) | (c == 127) ifTrue: [up bs; upcall: 32; bs]
				ifFalse: [(c == 10) | (c == 13) ifTrue: [up newline]
				ifFalse: [c >= 32 ifTrue: [up upcall: c]]].
			up flush.]! !

!ProtocolAdaptor methodsFor: 'canned protocols'!
pass

	^self
		upBlock: [:arg | up upcall: arg];
		downBlock: [:arg | down downcall: arg]! !

!ProtocolAdaptor methodsFor: 'canned protocols'!
reflect

	^self
		upBlock: [:arg | down downcall: arg];
		downBlock: [:arg | up upcall: arg; flush]! !

!ProtocolAdaptor methodsFor: 'canned protocols'!
trace

	^self
		upBlock: [:arg |
			Transcript cr; nextPutAll: 'up ' , arg printString; endEntry.
			up upcall: arg];
		downBlock: [:arg |
			Transcript cr; nextPutAll: 'down ' , arg printString; endEntry.
			down downcall: arg]! !

!ProtocolAdaptor methodsFor: 'accessing'!
downBlock: block

	downBlock _ block! !

!ProtocolAdaptor methodsFor: 'accessing'!
flushBlock: block

	flushBlock _ block! !

!ProtocolAdaptor methodsFor: 'accessing'!
noteBlock: block

	noteBlock _ block! !

!ProtocolAdaptor methodsFor: 'accessing'!
upBlock: block

	upBlock _ block! !

!ProtocolAdaptor methodsFor: 'protocol'!
downcall: arg

	downBlock value: arg! !

!ProtocolAdaptor methodsFor: 'protocol'!
flush

	flushBlock value! !

!ProtocolAdaptor methodsFor: 'protocol'!
note: aSymbol with: anObject

	noteBlock value: aSymbol value: anObject! !

!ProtocolAdaptor methodsFor: 'protocol'!
upcall: arg

	upBlock value: arg! !


!ProtocolAdaptor class methodsFor: 'instance creation'!
new

	^super new initialize! !

!ProtocolAdaptor class methodsFor: 'instance creation'!
upBlock: aBlock

	^self new upBlock: aBlock! !


!ProtocolEndpoint methodsFor: 'protocol'!
close
	"Terminate the connection to the remote entity."

	^self subclassResponsibility! !

!ProtocolEndpoint methodsFor: 'protocol'!
downcall: anObject
	"Receive anObject from my high protocol.  The default behaviour (in Protocol) is to pass it down to my low protocol.  ProtocolEndpoints however are at the bottom of the ProtocolStack and thus have no low protocol, so they have to treat this specially (e.g., by sending the data over the network or to another process)."

	^self subclassResponsibility! !

!ProtocolEndpoint methodsFor: 'protocol'!
isConnected
	"Answer whether the endpoint is still connected."

	^self subclassResponsibility! !

!ProtocolEndpoint methodsFor: 'protocol'!
name
	"Answer the name of the remote entity."

	^self subclassResponsibility! !

!ProtocolEndpoint methodsFor: 'protocol'!
note: aSymbol with: anObject

	super note: aSymbol with: anObject.
	aSymbol == #endpointClosed ifTrue: [^self terminateServer].
	aSymbol == #windowClosed ifTrue: [^self close].! !

!ProtocolEndpoint methodsFor: 'protocol'!
run
	"Spawn a background process running the serverLoop."

	super run.
	serverProcess _ [self serverLoop] forkAt: Processor userSchedulingPriority.! !

!ProtocolEndpoint methodsFor: 'server loop'!
getData
	"Answer a collection of data to be passed up the protocol stack, or nil if the endpoint has failed."

	^self subclassResponsibility! !

!ProtocolEndpoint methodsFor: 'server loop'!
serverLoop
	"I sit in a loop (usually in a background Process) waiting for data to arrive on my underlying connection then pass anything received up to my high protocol.  When #getData answers nil to inform me that my underlying connection has been destroyed I close down the entire endpoint, inform my session of the fact and then exit.  See also ProtocolEndpoint>>run."

	| buf |
"MessageTally spyOn: ["
	Transcript cr; show: self class name, ' server running'.
	[(buf _ self getData) notNil] whileTrue: [up upcallAll: buf].
	serverProcess _ nil.
	self sessionNote: #endpointClosed; close.
	Transcript cr; show: self class name, ' server terminated'.
"] toFileNamed: 'spy.out'"! !

!ProtocolEndpoint methodsFor: 'server loop'!
terminateServer
	"Terminate the serverLoop process.  This should never be called directly: use #close instead."

	serverProcess isNil
		ifFalse:
			[serverProcess terminate.
			 serverProcess _ nil.
			 self sessionNote: #disconnected.
			 Transcript cr; show: self class name, ' server terminated']! !


!NetworkEndpoint methodsFor: 'accessing'!
getData

	| buf count |
	Processor yield.
	buf _ ByteArray new: 1024.
	[socket dataAvailable
		ifTrue:
			[count _ socket receiveDataInto: buf.
			 ^buf copyFrom: 1 to: count]
		ifFalse:
			[up flush.
			 socket waitForDataUntil: (Socket deadlineSecs: 1)].
	 socket isConnected]
		whileTrue.
	^nil! !

!NetworkEndpoint methodsFor: 'accessing'!
isConnected

	^socket notNil and: [socket isConnected]! !

!NetworkEndpoint methodsFor: 'accessing'!
name
	"Answer the name of the peer."

	(socket isNil or: [socket isConnected not])
		ifTrue: [^'not connected'].
	^NetNameResolver stringFromAddress: socket remoteAddress! !

!NetworkEndpoint methodsFor: 'accessing'!
socket

	^socket! !

!NetworkEndpoint methodsFor: 'protocol stack'!
downcall: char

	socket isConnected
		ifTrue: [socket sendData: (ByteArray with: char)]
		ifFalse: [socket closeAndDestroy]! !

!NetworkEndpoint methodsFor: 'protocol stack'!
downcallAll: collection
	"This is just for speed in telnet negotiation."

	socket isConnected
		ifTrue: [socket sendData: collection]
		ifFalse: [socket closeAndDestroy]! !

!NetworkEndpoint methodsFor: 'protocol stack'!
note: aSymbol with: anObject

	super note: aSymbol with: anObject.
	aSymbol == #connectedTo		ifTrue: [^self ttyMsgCR: 'Connected to ', anObject, '.'].
	aSymbol == #endpointClosed		ifTrue: [^self ttyCR; ttyMsgCR: 'Connection closed.'].
	aSymbol == #oobInlineEndpoint	ifTrue: [^socket setOption: 'SO_OOBINLINE' value: 1].
	aSymbol == #savePreferences		ifTrue: [^self savePreferences: anObject].! !

!NetworkEndpoint methodsFor: 'protocol stack'!
run

	self isConnected ifTrue: [self sessionNote: #connectedTo with: self name].
	super run! !

!NetworkEndpoint methodsFor: 'initialize-release'!
close

	socket notNil ifTrue: [socket close]! !

!NetworkEndpoint methodsFor: 'initialize-release'!
socket: aSocket

	socket _ aSocket! !

!NetworkEndpoint methodsFor: 'debugging'!
rcvd: char

	| str |
	str _ char asInteger printStringBase: 16.
	str _ str copyFrom: 4 to: str size.
	Transcript cr; nextPut: $<; tab; nextPutAll: (str padded: #left to: 2 with: $0); tab; nextPut: char asCharacter! !

!NetworkEndpoint methodsFor: 'debugging'!
sent: char

	| str |
	str _ char asInteger printStringBase: 16.
	str _ str copyFrom: 4 to: str size.
	Transcript cr; nextPut: $>; tab; nextPutAll: (str padded: #left to: 2 with: $0); tab; nextPut: char asCharacter! !

!NetworkEndpoint methodsFor: 'private'!
savePreferences: dict

	dict at: #endpointClass put: self class name.
	dict at: #endpointCreate put: #newConnection:port:.
	dict at: #endpointArguments put: (Array with: socket name with: socket remotePort)! !


!NetworkEndpoint class methodsFor: 'examples'!
example
	"NetworkEndpoint example"

	^NetworkEndpoint new
		socket: ((Socket initializeNetwork; new)
					connectTo: (NetNameResolver addressForName: 'localhost') port: 13;
					waitForConnectionUntil: (Socket deadlineSecs: 1);
					yourself);
		up: (ProtocolAdaptor new
				upBlock: [:arg | Transcript nextPut: arg asCharacter; endEntry]);
		run.! !

!NetworkEndpoint class methodsFor: 'examples'!
example2
	"NetworkEndpoint example2"

	| s |
	NetworkEndpoint new
		socket: ((s _ Socket initializeNetwork; new)
					connectTo: (NetNameResolver addressForName: 'localhost') port: 7;
					waitForConnectionUntil: (Socket deadlineSecs: 1);
					yourself);
		up: (ProtocolAdaptor new
				upBlock: [:arg | Transcript nextPut: arg asCharacter; endEntry]);
		run.
	s sendData: 'send this back to me'.
	(Delay forSeconds: 1) wait.
	s close! !

!NetworkEndpoint class methodsFor: 'examples'!
example3
	"NetworkEndpoint example3"

	| ep |
	(ep _ NetworkEndpoint newConnection: 'localhost' port: 7)
		up: (ProtocolAdaptor upBlock:
				[:arg | Transcript nextPut: arg asCharacter; endEntry]);
		run.
	ep socket sendData: 'send this back to me'.
	(Delay forSeconds: 1) wait.
	ep socket close! !

!NetworkEndpoint class methodsFor: 'examples'!
newConnection: host port: port

	| s addr |
	Socket initializeNetwork.
	(addr _ NetNameResolver addressForName: host) isNil
		ifTrue: [^nil].
	(s _ SafeSocket new)
		connectTo: addr port: port;
		waitForConnectionUntil: Socket standardDeadline.
	s isWaitingForConnection
		ifTrue: [s destroy. ^nil].
	s name: host.
	^self new socket: s! !


!ProcessEndpoint methodsFor: 'initialize-release'!
command: cmd arguments: args

	(pty _ PseudoTTY command: cmd arguments: args)
		isNil ifTrue: [^self error: 'could not create process'].
	command _ cmd.
	arguments _ args.! !

!ProcessEndpoint methodsFor: 'protocol'!
close

	pty close.! !

!ProcessEndpoint methodsFor: 'protocol'!
downcall: char

	pty nextPut: char! !

!ProcessEndpoint methodsFor: 'protocol'!
isConnected

	^pty isConnected! !

!ProcessEndpoint methodsFor: 'protocol'!
name

	^pty name! !

!ProcessEndpoint methodsFor: 'protocol'!
note: aSymbol with: anObject

	super note: aSymbol with: anObject.
	aSymbol == #windowSize		ifTrue: [^pty noteWindowSize: anObject "Point"].
	aSymbol == #endpointClosed	ifTrue: [^self ttyCR; ttyMsgCR: 'Process terminated.'].
	aSymbol == #savePreferences	ifTrue: [^self savePreferences: anObject]! !

!ProcessEndpoint methodsFor: 'server loop'!
getData
	"Answer the next chunk of stuff from the pty or nil if the pty has been closed."

	| buf |
	pty isConnected ifFalse: [^nil].
	Processor yield.
	(buf _ pty peekUpToEnd) isNil ifTrue: [up flush.  buf _ pty upToEnd].
	^buf! !

!ProcessEndpoint methodsFor: 'private'!
savePreferences: dict

	dict
		at: #endpointClass put: self class name;
		at: #endpointCreate put: #command:arguments:;
		at: #endpointArguments put: (Array with: command with: arguments)! !


!ProcessEndpoint class methodsFor: 'instance creation'!
command: command

	^self command: command arguments: nil! !

!ProcessEndpoint class methodsFor: 'instance creation'!
command: command arguments: arguments

	^self new command: command arguments: arguments! !

!ProcessEndpoint class methodsFor: 'instance creation'!
example
	"ProcessEndpoint example upToEnd asString"

	^ProcessEndpoint command: '/bin/bash' arguments: #('-ec' '/bin/pwd')! !

!ProcessEndpoint class methodsFor: 'instance creation'!
example2
	"ProcessEndpoint example2"

	| tty |
	^LayeredProtocol new
		addDown: (tty _ TeletypeMorph open);
		addDown: (XtermEmulator new window: tty);
		addDown: (ProcessEndpoint command: '/bin/bash' arguments: #('-i'));
		install;
		run! !

!ProcessEndpoint class methodsFor: 'instance creation'!
example3
	"ProcessEndpoint example3"

	^(LayeredProtocol
		on:		(ProcessEndpoint command: '/bin/bash' arguments: #('-i')))
		push:	XtermEmulator new;
		push:	TeletypeMorph open;
		install;
		run! !


!ProtocolState methodsFor: 'accessing'!
add: anAssociation

	^self transitionAt: anAssociation key put: (self transitionFor: anAssociation value)! !

!ProtocolState methodsFor: 'accessing'!
addAll: anAssociation

	^self atAll: anAssociation key put: anAssociation value! !

!ProtocolState methodsFor: 'accessing'!
addAllInteger: anAssociation

	^self atAllInteger: anAssociation key put: anAssociation value! !

!ProtocolState methodsFor: 'accessing'!
addInteger: anAssociation

	^self transitionAt: anAssociation key asInteger put: (self transitionFor: anAssociation value)! !

!ProtocolState methodsFor: 'accessing'!
at: key put: transition

	^self transitionAt: key put: (self transitionFor: transition)! !

!ProtocolState methodsFor: 'accessing'!
at: anObject to: limit put: transition

	| edge |
	edge _ self transitionFor: transition.
	anObject to: limit do: [:target | self transitionAt: target put: edge]! !

!ProtocolState methodsFor: 'accessing'!
atAll: collection put: transition
	| edge |
	edge _ self transitionFor: transition.
	collection do: [:elt | self transitionAt: elt put: edge]! !

!ProtocolState methodsFor: 'accessing'!
atAllInteger: collection put: transition
	| edge |
	edge _ self transitionFor: transition.
	collection do: [:elt | self transitionAt: elt asInteger put: edge]! !

!ProtocolState methodsFor: 'accessing'!
default

	^default! !

!ProtocolState methodsFor: 'accessing'!
default: transition

	self defaultTransition: (self transitionFor: transition)! !

!ProtocolState methodsFor: 'accessing'!
defaultTransition: aTransition

	default _ aTransition! !

!ProtocolState methodsFor: 'accessing'!
name

	^name! !

!ProtocolState methodsFor: 'accessing'!
name: aSymbol

	name _ aSymbol! !

!ProtocolState methodsFor: 'accessing'!
transitionAt: key

	^super at: key ifAbsent: [default]! !

!ProtocolState methodsFor: 'accessing'!
transitionAt: key put: edge

	^super at: key put: edge! !

!ProtocolState methodsFor: 'printing'!
printElementsOn: aStream

	aStream nextPutAll: '(name: ' , name printString.
	aStream nextPutAll: ' default: ' , default printString.
	aStream nextPutAll: ' transitions:'.
	self associationsDo: [:transition | aStream space.  transition printOn: aStream.].
	aStream nextPut: $).! !

!ProtocolState methodsFor: 'private'!
transitionFor: transition

	^ProtocolStateTransition action: transition key state: transition value! !


!ProtocolState class methodsFor: 'instance creation'!
name: myName default: aTransition
	^self new
		name: myName;
		default: aTransition! !

!ProtocolState class methodsFor: 'examples'!
example
	"ProtocolState example"

	^(self name: #initial default: #echo: -> #initial)
		at: 42 put: #echo42: -> #initial;
		yourself! !


!ProtocolStateTransition methodsFor: 'accessing'!
action

	^action! !

!ProtocolStateTransition methodsFor: 'accessing'!
action: aSymbol

	action _ aSymbol! !

!ProtocolStateTransition methodsFor: 'accessing'!
state

	^state! !

!ProtocolStateTransition methodsFor: 'accessing'!
state: aState

	state _ aState! !

!ProtocolStateTransition methodsFor: 'state transitions'!
transitionFrom: lastState for: aClient with: anObject

	action isNil ifFalse: [aClient perform: action with: anObject].
	^state isNil ifTrue: [lastState] ifFalse: [state]! !

!ProtocolStateTransition methodsFor: 'printing'!
printOn: aStream

	aStream nextPut: ${.
	action printOn: aStream.
	aStream nextPutAll: ' -> '.
	aStream nextPutAll: ((state isMemberOf: Symbol)
		ifTrue: [state]
		ifFalse: [state name]) printString.
	aStream nextPut: $}! !


!ProtocolStateTransition class methodsFor: 'instance creation'!
action: aSymbol

	^self new state: nil; action: aSymbol! !

!ProtocolStateTransition class methodsFor: 'instance creation'!
action: aSymbol state: aState

	^self new state: aState; action: aSymbol! !

!ProtocolStateTransition class methodsFor: 'instance creation'!
state: aState

	^self new state: aState; action: nil! !

!ProtocolStateTransition class methodsFor: 'instance creation'!
state: aState action: aSymbol

	^self new state: aState; action: aSymbol! !


!SafeSocket methodsFor: 'initialize-release'!
close

	super close.
	InstanceList remove: self ifAbsent: []! !

!SafeSocket methodsFor: 'initialize-release'!
connectTo: host port: port

	hostName _ host.
	^super connectTo: hostName port: port! !

!SafeSocket methodsFor: 'accessing'!
name
	"Answer the name of the peer."

	^self isConnected
		ifTrue: [hostName isNil ifTrue: [NetNameResolver stringFromAddress: self remoteAddress] ifFalse: [hostName]]
		ifFalse: ['not connected']! !

!SafeSocket methodsFor: 'accessing'!
name: aString
	"Set the name of the connection."

	hostName _ aString! !

!SafeSocket methodsFor: 'primitives'!
primSocketCloseConnection: socketID
	"Close the connection on the given port. The remote end is informed that this end has closed and will do no further sends. This is an asynchronous call; query the socket status to discover if and when the connection is actually closed.  Overriden to avoid primitive fail error in superclass."

	<primitive: 'primitiveSocketCloseConnection' module: 'SocketPlugin'>! !

!SafeSocket methodsFor: 'primitives'!
primSocketReceiveDataAvailable: socketID
	"Return true if data may be available for reading from the current socket.  Overridden to avoid primitive failure when the socket is closed asynchronously (or left open across snapshot and quit)."

	<primitive: 'primitiveSocketReceiveDataAvailable' module: 'SocketPlugin'>
	^false! !


!SafeSocket class methodsFor: 'class initialization'!
initialize
	"SafeSocket initialize"

	InstanceList _ IdentitySet new.
	Smalltalk
		addToStartUpList: self;
		addToShutDownList: self.! !

!SafeSocket class methodsFor: 'instance creation'!
new

	^InstanceList add: super new! !

!SafeSocket class methodsFor: 'snapshot'!
shutDown: quitting
	"We're about to snapshot and quit: shut down any open connections."

	InstanceList _ InstanceList select: [ :sock | sock isConnected].
	(quitting and: [InstanceList notEmpty]) ifTrue:
		[(self confirm: (String streamContents: [ :str |
				str nextPutAll: 'Open network connections exist to the following hosts:'.
				InstanceList do: [ :sock | str cr; tab; nextPutAll: sock name].
				str cr; nextPutAll: 'Do you want to shut them down before quitting?']))
			ifTrue: [InstanceList do: [:sock | sock close]]]! !

!SafeSocket class methodsFor: 'snapshot'!
startUp: resuming
	"We're coming back from snapshot and quit.  Close any connections that were left open in the snapshot."

	(resuming and: [InstanceList notEmpty])
		ifTrue: [InstanceList do: [ :sock | sock close]]! !


!SimpleTextMorph methodsFor: 'initialize-release'!
contents: aLineState
	"Initialize the receiver with the given contents."

	super initialize.
	font _ self defaultFont.
	fgMap _ Foreground shallowCopy.
	bgMap _ Background shallowCopy.
	lineState _ aLineState.
	pitch _ font widthOfString: ' '.
	color _ Color white.
	rv _ false.
	cursorColour _ nil.! !

!SimpleTextMorph methodsFor: 'initialize-release'!
initialize
	"Initialize the receiver with empty contents."

	self contents: SimpleTextState new.! !

!SimpleTextMorph methodsFor: 'accessing'!
cursorColour: cc

	cursorColour _ cc.! !

!SimpleTextMorph methodsFor: 'accessing'!
ec: aBoolean

	aBoolean ifTrue: [self emacsColours] ifFalse: [self normalColours]! !

!SimpleTextMorph methodsFor: 'accessing'!
emacsColours

	fgMap _ Foreground2 shallowCopy.
	bgMap _ Background2 shallowCopy.
	rv ifTrue: [self reversePolarity]! !

!SimpleTextMorph methodsFor: 'accessing'!
lineState
	"Answer an opaque representation of the line contents"

	^lineState! !

!SimpleTextMorph methodsFor: 'accessing'!
lineState: state
	"Restore the line contents from the given state"

	lineState _ state.
	state changed: true.		"force redraw on next cycle"! !

!SimpleTextMorph methodsFor: 'accessing'!
normalColours

	fgMap _ Foreground shallowCopy.
	bgMap _ Background shallowCopy.
	rv ifTrue: [self reversePolarity]! !

!SimpleTextMorph methodsFor: 'accessing'!
rv: aBoolean

	aBoolean ~~ rv
		ifTrue:
			[rv _ aBoolean.
			 self reversePolarity]! !

!SimpleTextMorph methodsFor: 'drawing'!
drawCursorOn: aCanvas

	| cc bg fg |
	lineState cursorColumn > 0 ifTrue:
		[cc _ lineState cursorColumn min: lineState stringSize.
		 (lineState selectionSpansColumn:  cc)
			ifTrue:
				[fg _ self backgroundColourAt: (lineState bgRuns at: cc).
				 bg _ self foregroundColourAt: (lineState fgRuns at: cc)]
			ifFalse:
				[bg _ self backgroundColourAt: (lineState bgRuns at: cc).
				 fg _ cursorColour isNil ifTrue: [self foregroundColourAt: (lineState fgRuns at: cc)] ifFalse: [cursorColour]].
		 owner hasFocus
			ifTrue: [aCanvas
				drawString: lineState string
				from: cc to: cc
				in: (bounds insetOriginBy: (pitch * (cc - 1) @ 0) cornerBy: 0@0)
				font: font
				color: bg
				background: fg]
			ifFalse: [aCanvas
				frameRectangle: (bounds origin + (pitch * (cc - 1) @ 0) extent: pitch @ font height)
				width: 1
				color: fg]].! !

!SimpleTextMorph methodsFor: 'drawing'!
drawLineOn: aCanvas

	| port tmp |
	self runsDo: [:l :r :fg :bg :em |
		port _ bounds left + (l - 1 * pitch) @ bounds top corner: bounds left + (lineState stringSize * pitch) @ bounds bottom.
		(em bitAnd: 64) == 64 ifTrue: [tmp _ fg.  fg _ bg.  bg _ tmp].
		aCanvas
			"fillRectangle: port fillStyle: bg;"
			drawString: lineState string
			from: l to: r in: port
			font: font
			color: fg
			background: bg.
		(em bitAnd: 1) == 1 ifTrue:	"bold"
			[aCanvas drawString: lineState string from: l to: r at: port topLeft + (1@0) font: font color: fg].
		(em bitAnd: 8) == 8 ifTrue:	"underline"
			[aCanvas line: port bottomLeft - (0@1) to: port bottomRight - (1@1) width: 1 color: fg]].
! !

!SimpleTextMorph methodsFor: 'drawing'!
drawOn: aCanvas

	super drawOn: aCanvas.
	self
		drawLineOn: aCanvas;
		drawCursorOn: aCanvas! !

!SimpleTextMorph methodsFor: 'drawing'!
fitContents
	"If the receiver has changed width then update my geometry."

	self extent: lineState stringSize * pitch @ font height! !

!SimpleTextMorph methodsFor: 'drawing'!
oldDrawLineOn: aCanvas

	| port tmp |
	self runsDo: [:l :r :fg :bg :em |
		port _ bounds insetOriginBy: (pitch * (l - 1) @ 0) cornerBy: 0@0.
		(em bitAnd: 64) == 64 ifTrue: [tmp _ fg.  fg _ bg.  bg _ tmp].
		aCanvas
			"fillRectangle: port fillStyle: bg;"
			drawString: lineState string
			from: l to: r in: port
			font: font
			color: fg
			background: bg.
		(em bitAnd: 1) == 1 ifTrue:	"bold"
			[aCanvas drawString: lineState string from: l to: r at: port topLeft + (1@0) font: font color: fg].
		(em bitAnd: 8) == 8 ifTrue:	"underline"
			[aCanvas line: port bottomLeft - (0@1) to: port bottomRight - (1@1) width: 1 color: fg]].
! !

!SimpleTextMorph methodsFor: 'selection'!
selectionColumnAt: screenPosition
	"Answer the column of the character at the given screen screenPosition.  If the screenPosition is within our bounds vertically but outside to the left or right then answer the first or last + 1 column respectively.  If the screenPosition is beyond lastCol then answer our width + 1."

	| x y col |
	x _ screenPosition x.
	y _ screenPosition y.
	(self bounds top <= y and: [self bounds bottom >= y]) ifFalse: [^nil].
	x <= self bounds left ifTrue: [^1].
	x >= self bounds right ifTrue: [^lineState stringSize + 1].
	col _ screenPosition x - self bounds left // pitch + 1 min: lineState stringSize max: 1.
	col > (lineState lastColumn + 1) ifTrue: [^lineState stringSize + 1].
	^col! !

!SimpleTextMorph methodsFor: 'private'!
backgroundColourAt: i

	^bgMap at: i + 1! !

!SimpleTextMorph methodsFor: 'private'!
defaultFont

	^((TextStyle named: DefaultStyle) isNil
		ifTrue: [TextStyle named: #Atlanta]
		ifFalse: [TextStyle named: DefaultStyle]) defaultFont! !

!SimpleTextMorph methodsFor: 'private'!
flush

	lineState changed
		ifTrue:
			[lineState changed: false.
			 self changed]! !

!SimpleTextMorph methodsFor: 'private'!
foregroundColourAt: i

	^fgMap at: i + 1! !

!SimpleTextMorph methodsFor: 'private'!
reversePolarity
	"It's almost daybreak and my method names are getting silly."

	fgMap swap: 1 with: fgMap size.
	bgMap swap: 1 with: bgMap size.! !

!SimpleTextMorph methodsFor: 'private'!
runsDo: aBlock

	| fg fgr bg bgr em emr left stringSize |
	stringSize _ lineState stringSize.
	bgr _ lineState bgRuns.  fgr _ lineState fgRuns.  emr _ lineState emRuns.
	bg _ bgr at: 1.  fg _ fgr at: 1.  em _ emr at: 1.
	left _ 1.
	2 to: stringSize do: [:i |
		(fg ~~ (fgr at: i) or: [bg ~~ (bgr at: i) or: [em ~~ (emr at: i)]])
			ifTrue:
				[aBlock
					value: left value: i - 1
					value: (self foregroundColourAt: fg)
					value: (self backgroundColourAt: bg)
					value: em.
				 bg _ bgr at: i.  fg _ fgr at: i.  em _ emr at: i.
				 left _ i]].
	aBlock
		value: left value: stringSize
		value: (self foregroundColourAt: fg)
		value: (self backgroundColourAt: bg)
		value: em! !


!SimpleTextMorph class methodsFor: 'class initialisation'!
initialize
	"SimpleTextMorph initialize"

	"ISO 6429 colour indices"
	Foreground _ #(black red green yellow blue magenta cyan white) collect: [:c | Color perform: c].
	Background _ #(black red green yellow blue magenta cyan white) collect: [:c | Color perform: c].
	"Alternate colour scheme for Emacs: reversed white/black on dark slate grey"
	(Foreground2 _ Foreground shallowCopy) at: 1 put: (Color white); at: 8 put: (Color black).
	(Background2 _ Background shallowCopy) at: 1 put: (Color white); at: 8 put: (Color fromString: '#314D52').
	false ifTrue: [
	2 to: 7 do: [:i |
		Foreground2 at: i put: ((Foreground2 at: i) adjustSaturation: -0.35 brightness: 0.5).
		Background2 at: i put: ((Background2 at: i) adjustSaturation: -0.35 brightness: 0.5)].
	] ifFalse: [
	(Foreground2 _ Foreground collect: [:c | c adjustSaturation: -0.35 brightness: 0.5])
		at: 1 put: (Color white "fromString: '#f7dfb5'"); at: 8 put: (Color black).
	(Background2 _ Background collect: [:c | c adjustSaturation: -0.35 brightness: 0.5])
		at: 1 put: (Color white); at: 8 put: (Color fromString: '#314D52').
	].
	"Offer to create the standard X11 'fixed' font with VT100 graphics and line-drawing characters"
	(TextStyle named: #Fixed) isNil ifTrue: [self initializeFonts].
	self defaultFont: #Fixed.! !

!SimpleTextMorph class methodsFor: 'class initialisation'!
initializeFonts
	"SimpleTextMorph initializeFonts"

	| file |
	(self confirm: 'The default fixed-width font is abominable.
Do you want me to create a better fixed-width font for you?')
		ifFalse: [^self].
	file _ FileStream newFileNamed: 'SimpleTextMorph-fixed.bdf'.
	file nextPutAll: self fixedFontDefinition; close.
	TextConstants at: #Fixed put: (TextStyle fontArray:
		{StrikeFont newFromBDFFile: 'SimpleTextMorph-fixed.bdf' name: 'Fixed13'}).
	FileDirectory default deleteFileNamed: 'SimpleTextMorph-fixed.bdf'.
	self inform: 'Font created as TextStyle named: #Fixed'.
"---
	(self confirm: 'The previous font is a little small on some high-resolution displays.
Would you also like me to create a larger fixed-width font for you?')
		ifFalse: [^self].
	file _ FileStream newFileNamed: 'SimpleTextMorph-lucida.bdf'.
	file nextPutAll: self fixedFontDefinition2; close.
	TextConstants at: #LucidaConsole put: (TextStyle fontArray:
		{StrikeFont newFromBDFFile: 'SimpleTextMorph-lucida.bdf' name: 'LucidaConsole12'}).
	FileDirectory default deleteFileNamed: 'SimpleTextMorph-lucida.bdf'.
	self inform: 'Font created as TextStyle named: #LucidaConsole'.
---"
! !

!SimpleTextMorph class methodsFor: 'instance creation'!
contents: lineState

	^super new contents: lineState! !

!SimpleTextMorph class methodsFor: 'instance creation'!
new

	^super new initialize! !

!SimpleTextMorph class methodsFor: 'accessing'!
defaultFont

	^DefaultStyle! !

!SimpleTextMorph class methodsFor: 'accessing'!
defaultFont: fontName

	DefaultStyle _ fontName! !

!SimpleTextMorph class methodsFor: 'examples'!
example

	"SimpleTextMorph example"

	| m |
	(m _ SimpleTextMorph new) lineState string: (String streamContents: [:s |
			0 to: 79 do: [:i | s nextPut: (Character value: i \\ 26 + $a asciiValue)]]).
	1 to: 80 do: [:i |
		m lineState foregroundAt: i put: i \\ 8.
		m lineState backgroundAt: i put: i - 1// 10].
	m openInWorld; fitContents; flush.
	^m! !

!SimpleTextMorph class methodsFor: 'examples'!
example2
	"One way (the wrong way) to implement blinking cursors."
	"SimpleTextMorph example2"

	| m |
	(m _ SimpleTextMorph new) lineState string: ('Hello, world.' padded: #right to: 80 with: $ ).
	m openInWorld; fitContents.
	[10 timesRepeat:
		[m lineState backgroundAt: 14 put: 0.  m flush.
		 (Delay forMilliseconds: 600) wait.
		 m lineState backgroundAt: 14 put: 7; changed.  m flush.
		 (Delay forMilliseconds: 300) wait].
	 m abandon] forkAt: Processor highIOPriority.
	^m! !

!SimpleTextMorph class methodsFor: 'examples'!
example3
	"SimpleTextMorph example3"

	| m |
	(m _ SimpleTextMorph new) lineState string: ('Hello, world.' padded: #right to: 80 with: $ ).
	m openInWorld; fitContents.
	m cursorColour: Preferences textHighlightColor.
	m lineState cursorCol: 14.
	^m! !

!SimpleTextMorph class methodsFor: 'private'!
fixedFontDefinition
	"This is -misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso8859-1 (aka 'fixed')"

	^'STARTFONT 2.1
COMMENT $XConsortium: 6x13.bdf,v 1.13 92/04/02 14:24:50 gildea Exp $
COMMENT ""
COMMENT Characters above 127 designed and made by
COMMENT Thomas Bagli (pyramid!!pcsbst!!tom@uunet.UU.NET)
COMMENT PCS Computer Systeme, West Germany
COMMENT ""
FONT -Misc-Fixed-Medium-R-SemiCondensed--13-120-75-75-C-60-ISO8859-1
SIZE 13 78 78
FONTBOUNDINGBOX 6 13 0 -2
STARTPROPERTIES 19
FONTNAME_REGISTRY ""
FOUNDRY "Misc"
FAMILY_NAME "Fixed"
WEIGHT_NAME "Medium"
SLANT "R"
SETWIDTH_NAME "SemiCondensed"
ADD_STYLE_NAME ""
PIXEL_SIZE 13
POINT_SIZE 120
RESOLUTION_X 75
RESOLUTION_Y 75
SPACING "C"
AVERAGE_WIDTH 60
CHARSET_REGISTRY "ISO8859"
CHARSET_ENCODING "1"
DEFAULT_CHAR 0
FONT_DESCENT 2
FONT_ASCENT 11
COPYRIGHT "Public domain font.  Share and enjoy."
ENDPROPERTIES
CHARS 224
STARTCHAR ascii000
ENCODING 0
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
78
78
78
78
78
78
78
78
78
78
78
00
ENDCHAR
STARTCHAR ascii001
ENCODING 1
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
20
70
f8
70
20
00
00
00
ENDCHAR
STARTCHAR ascii002
ENCODING 2
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
54
a8
54
a8
54
a8
54
a8
54
a8
54
a8
ENDCHAR
STARTCHAR ascii003
ENCODING 3
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
a0
a0
e0
a0
a0
70
20
20
20
ENDCHAR
STARTCHAR ascii004
ENCODING 4
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
e0
80
c0
80
f0
40
60
40
40
ENDCHAR
STARTCHAR ascii005
ENCODING 5
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
70
80
80
70
70
48
70
50
48
ENDCHAR
STARTCHAR ascii006
ENCODING 6
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
80
80
80
e0
70
40
60
40
40
ENDCHAR
STARTCHAR ascii007
ENCODING 7
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
60
90
90
60
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR ascii010
ENCODING 8
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
20
20
f8
20
20
00
f8
00
00
ENDCHAR
STARTCHAR ascii011
ENCODING 9
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
88
c8
a8
98
88
40
40
40
78
ENDCHAR
STARTCHAR ascii012
ENCODING 10
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
88
88
50
20
00
f8
20
20
20
ENDCHAR
STARTCHAR ascii013
ENCODING 11
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
e0
00
00
00
00
00
ENDCHAR
STARTCHAR ascii014
ENCODING 12
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
e0
20
20
20
20
20
ENDCHAR
STARTCHAR ascii015
ENCODING 13
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
3c
20
20
20
20
20
ENDCHAR
STARTCHAR ascii016
ENCODING 14
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
3c
00
00
00
00
00
ENDCHAR
STARTCHAR ascii017
ENCODING 15
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
fc
20
20
20
20
20
ENDCHAR
STARTCHAR ascii020
ENCODING 16
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
fc
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR ascii021
ENCODING 17
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
fc
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR ascii022
ENCODING 18
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
fc
00
00
00
00
00
ENDCHAR
STARTCHAR ascii023
ENCODING 19
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
fc
00
00
00
ENDCHAR
STARTCHAR ascii024
ENCODING 20
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
00
00
fc
00
ENDCHAR
STARTCHAR ascii025
ENCODING 21
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
3c
20
20
20
20
20
ENDCHAR
STARTCHAR ascii026
ENCODING 22
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
e0
20
20
20
20
20
ENDCHAR
STARTCHAR ascii027
ENCODING 23
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
fc
00
00
00
00
00
ENDCHAR
STARTCHAR ascii030
ENCODING 24
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
fc
20
20
20
20
20
ENDCHAR
STARTCHAR ascii031
ENCODING 25
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
20
20
20
20
20
20
20
20
20
20
20
20
20
ENDCHAR
STARTCHAR ascii032
ENCODING 26
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
08
10
20
40
20
10
08
f8
00
00
ENDCHAR
STARTCHAR ascii033
ENCODING 27
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
80
40
20
10
20
40
80
f8
00
00
ENDCHAR
STARTCHAR ascii034
ENCODING 28
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
f8
50
50
50
50
90
00
00
ENDCHAR
STARTCHAR ascii035
ENCODING 29
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
08
f8
20
f8
80
00
00
00
ENDCHAR
STARTCHAR ascii036
ENCODING 30
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
48
40
40
e0
40
40
48
b0
00
00
ENDCHAR
STARTCHAR ascii037
ENCODING 31
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
20
00
00
00
00
ENDCHAR
STARTCHAR space
ENCODING 32
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR exclam
ENCODING 33
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
20
20
20
20
20
20
00
20
00
00
ENDCHAR
STARTCHAR quotedbl
ENCODING 34
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
50
50
50
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR numbersign
ENCODING 35
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
50
50
f8
50
f8
50
50
00
00
00
ENDCHAR
STARTCHAR dollar
ENCODING 36
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
78
a0
a0
70
28
28
f0
20
00
00
ENDCHAR
STARTCHAR percent
ENCODING 37
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
48
a8
50
10
20
40
50
a8
90
00
00
ENDCHAR
STARTCHAR ampersand
ENCODING 38
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
40
a0
a0
40
a0
98
90
68
00
00
00
ENDCHAR
STARTCHAR quoteright
ENCODING 39
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
20
40
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR parenleft
ENCODING 40
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
10
20
20
40
40
40
20
20
10
00
00
ENDCHAR
STARTCHAR parenright
ENCODING 41
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
40
20
20
10
10
10
20
20
40
00
00
ENDCHAR
STARTCHAR asterisk
ENCODING 42
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
20
a8
f8
70
f8
a8
20
00
00
00
ENDCHAR
STARTCHAR plus
ENCODING 43
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
20
20
f8
20
20
00
00
00
00
ENDCHAR
STARTCHAR comma
ENCODING 44
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
30
20
40
00
ENDCHAR
STARTCHAR hyphen
ENCODING 45
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
f8
00
00
00
00
00
00
ENDCHAR
STARTCHAR period
ENCODING 46
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
20
70
20
00
ENDCHAR
STARTCHAR slash
ENCODING 47
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
08
08
10
10
20
40
40
80
80
00
00
ENDCHAR
STARTCHAR zero
ENCODING 48
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
50
88
88
88
88
88
50
20
00
00
ENDCHAR
STARTCHAR one
ENCODING 49
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
60
a0
20
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR two
ENCODING 50
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
08
10
20
40
80
f8
00
00
ENDCHAR
STARTCHAR three
ENCODING 51
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
08
10
20
70
08
08
88
70
00
00
ENDCHAR
STARTCHAR four
ENCODING 52
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
10
10
30
50
50
90
f8
10
10
00
00
ENDCHAR
STARTCHAR five
ENCODING 53
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
80
80
b0
c8
08
08
88
70
00
00
ENDCHAR
STARTCHAR six
ENCODING 54
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
80
80
f0
88
88
88
70
00
00
ENDCHAR
STARTCHAR seven
ENCODING 55
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
08
10
10
20
20
40
40
40
00
00
ENDCHAR
STARTCHAR eight
ENCODING 56
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
88
70
88
88
88
70
00
00
ENDCHAR
STARTCHAR nine
ENCODING 57
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
88
78
08
08
88
70
00
00
ENDCHAR
STARTCHAR colon
ENCODING 58
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
20
70
20
00
00
20
70
20
00
ENDCHAR
STARTCHAR semicolon
ENCODING 59
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
20
70
20
00
00
30
20
40
00
ENDCHAR
STARTCHAR less
ENCODING 60
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
08
10
20
40
80
40
20
10
08
00
00
ENDCHAR
STARTCHAR equal
ENCODING 61
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
f8
00
00
f8
00
00
00
00
ENDCHAR
STARTCHAR greater
ENCODING 62
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
40
20
10
08
10
20
40
80
00
00
ENDCHAR
STARTCHAR question
ENCODING 63
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
08
10
20
20
00
20
00
00
ENDCHAR
STARTCHAR at
ENCODING 64
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
98
a8
a8
b0
80
78
00
00
ENDCHAR
STARTCHAR A
ENCODING 65
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
50
88
88
88
f8
88
88
88
00
00
ENDCHAR
STARTCHAR B
ENCODING 66
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f0
48
48
48
70
48
48
48
f0
00
00
ENDCHAR
STARTCHAR C
ENCODING 67
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
80
80
80
80
80
88
70
00
00
ENDCHAR
STARTCHAR D
ENCODING 68
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f0
48
48
48
48
48
48
48
f0
00
00
ENDCHAR
STARTCHAR E
ENCODING 69
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
80
80
80
f0
80
80
80
f8
00
00
ENDCHAR
STARTCHAR F
ENCODING 70
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
80
80
80
f0
80
80
80
80
00
00
ENDCHAR
STARTCHAR G
ENCODING 71
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
80
80
80
98
88
88
70
00
00
ENDCHAR
STARTCHAR H
ENCODING 72
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
88
88
f8
88
88
88
88
00
00
ENDCHAR
STARTCHAR I
ENCODING 73
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
20
20
20
20
20
20
20
70
00
00
ENDCHAR
STARTCHAR J
ENCODING 74
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
38
10
10
10
10
10
10
90
60
00
00
ENDCHAR
STARTCHAR K
ENCODING 75
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
90
a0
c0
a0
90
88
88
00
00
ENDCHAR
STARTCHAR L
ENCODING 76
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
80
80
80
80
80
80
80
f8
00
00
ENDCHAR
STARTCHAR M
ENCODING 77
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
d8
a8
a8
88
88
88
88
00
00
ENDCHAR
STARTCHAR N
ENCODING 78
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
c8
c8
a8
a8
98
98
88
88
00
00
ENDCHAR
STARTCHAR O
ENCODING 79
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR P
ENCODING 80
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f0
88
88
88
f0
80
80
80
80
00
00
ENDCHAR
STARTCHAR Q
ENCODING 81
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
88
88
88
88
88
a8
70
08
00
ENDCHAR
STARTCHAR R
ENCODING 82
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f0
88
88
88
f0
a0
90
88
88
00
00
ENDCHAR
STARTCHAR S
ENCODING 83
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
80
80
70
08
08
88
70
00
00
ENDCHAR
STARTCHAR T
ENCODING 84
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
20
20
20
20
20
20
20
20
00
00
ENDCHAR
STARTCHAR U
ENCODING 85
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
88
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR V
ENCODING 86
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
88
88
50
50
50
20
20
00
00
ENDCHAR
STARTCHAR W
ENCODING 87
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
88
88
a8
a8
a8
d8
88
00
00
ENDCHAR
STARTCHAR X
ENCODING 88
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
50
50
20
50
50
88
88
00
00
ENDCHAR
STARTCHAR Y
ENCODING 89
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
50
50
20
20
20
20
20
00
00
ENDCHAR
STARTCHAR Z
ENCODING 90
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
08
10
10
20
40
40
80
f8
00
00
ENDCHAR
STARTCHAR braketleft
ENCODING 91
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
40
40
40
40
40
40
40
70
00
00
ENDCHAR
STARTCHAR backslash
ENCODING 92
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
80
40
40
20
10
10
08
08
00
00
ENDCHAR
STARTCHAR bracketright
ENCODING 93
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
10
10
10
10
10
10
10
70
00
00
ENDCHAR
STARTCHAR asciicircum
ENCODING 94
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
50
88
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR underscore
ENCODING 95
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
00
00
f8
00
ENDCHAR
STARTCHAR quoteleft
ENCODING 96
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
10
08
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR a
ENCODING 97
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
08
78
88
88
78
00
00
ENDCHAR
STARTCHAR b
ENCODING 98
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
80
80
f0
88
88
88
88
f0
00
00
ENDCHAR
STARTCHAR c
ENCODING 99
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
88
80
80
88
70
00
00
ENDCHAR
STARTCHAR d
ENCODING 100
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
08
08
08
78
88
88
88
88
78
00
00
ENDCHAR
STARTCHAR e
ENCODING 101
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
88
f8
80
88
70
00
00
ENDCHAR
STARTCHAR f
ENCODING 102
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
48
40
40
f0
40
40
40
40
00
00
ENDCHAR
STARTCHAR g
ENCODING 103
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
88
88
88
78
08
88
70
ENDCHAR
STARTCHAR h
ENCODING 104
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
80
80
b0
c8
88
88
88
88
00
00
ENDCHAR
STARTCHAR i
ENCODING 105
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
20
00
60
20
20
20
20
70
00
00
ENDCHAR
STARTCHAR j
ENCODING 106
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
10
00
30
10
10
10
10
90
90
60
ENDCHAR
STARTCHAR k
ENCODING 107
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
80
80
90
a0
c0
a0
90
88
00
00
ENDCHAR
STARTCHAR l
ENCODING 108
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
60
20
20
20
20
20
20
20
70
00
00
ENDCHAR
STARTCHAR m
ENCODING 109
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
d0
a8
a8
a8
a8
88
00
00
ENDCHAR
STARTCHAR n
ENCODING 110
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
b0
c8
88
88
88
88
00
00
ENDCHAR
STARTCHAR o
ENCODING 111
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR p
ENCODING 112
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
f0
88
88
88
f0
80
80
80
ENDCHAR
STARTCHAR q
ENCODING 113
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
78
88
88
88
78
08
08
08
ENDCHAR
STARTCHAR r
ENCODING 114
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
b0
c8
80
80
80
80
00
00
ENDCHAR
STARTCHAR s
ENCODING 115
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
88
60
10
88
70
00
00
ENDCHAR
STARTCHAR t
ENCODING 116
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
40
40
f0
40
40
40
48
30
00
00
ENDCHAR
STARTCHAR u
ENCODING 117
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
88
88
88
98
68
00
00
ENDCHAR
STARTCHAR v
ENCODING 118
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
88
88
50
50
20
00
00
ENDCHAR
STARTCHAR w
ENCODING 119
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
88
a8
a8
a8
50
00
00
ENDCHAR
STARTCHAR x
ENCODING 120
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
50
20
20
50
88
00
00
ENDCHAR
STARTCHAR y
ENCODING 121
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
88
88
98
68
08
88
70
ENDCHAR
STARTCHAR z
ENCODING 122
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
f8
10
20
40
80
f8
00
00
ENDCHAR
STARTCHAR braceleft
ENCODING 123
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
18
20
20
20
c0
20
20
20
18
00
00
ENDCHAR
STARTCHAR bar
ENCODING 124
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
20
20
20
20
20
20
20
20
00
00
ENDCHAR
STARTCHAR braceright
ENCODING 125
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
c0
20
20
20
18
20
20
20
c0
00
00
ENDCHAR
STARTCHAR asciitilde
ENCODING 126
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
48
a8
90
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR ascii177
ENCODING 127
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00a0
ENCODING 160
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00a1
ENCODING 161
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
00
20
20
20
20
20
20
20
00
00
ENDCHAR
STARTCHAR 00a2
ENCODING 162
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
70
a8
a0
a0
a8
70
20
00
00
00
ENDCHAR
STARTCHAR 00a3
ENCODING 163
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
48
40
40
e0
40
40
48
b0
00
00
ENDCHAR
STARTCHAR 00a4
ENCODING 164
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
88
70
50
50
70
88
00
00
00
ENDCHAR
STARTCHAR 00a5
ENCODING 165
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
88
88
50
50
f8
20
f8
20
20
00
00
ENDCHAR
STARTCHAR 00a6
ENCODING 166
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
20
20
20
00
20
20
20
20
00
00
ENDCHAR
STARTCHAR 00a7
ENCODING 167
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
40
30
48
48
30
08
48
30
00
00
ENDCHAR
STARTCHAR 00a8
ENCODING 168
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
d8
00
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00a9
ENCODING 169
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
70
88
a8
d8
c8
d8
a8
88
70
00
00
00
ENDCHAR
STARTCHAR 00aa
ENCODING 170
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
08
78
88
78
00
f8
00
00
00
00
ENDCHAR
STARTCHAR 00ab
ENCODING 171
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
28
50
a0
a0
50
28
00
00
00
ENDCHAR
STARTCHAR 00ac
ENCODING 172
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
f8
08
08
00
00
00
00
ENDCHAR
STARTCHAR 00ad
ENCODING 173
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
f8
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00ae
ENCODING 174
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
70
88
e8
d8
d8
e8
d8
88
70
00
00
00
ENDCHAR
STARTCHAR 00af
ENCODING 175
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f8
00
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00b0
ENCODING 176
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
48
48
30
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00b1
ENCODING 177
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
20
20
f8
20
20
00
f8
00
00
00
ENDCHAR
STARTCHAR 00b2
ENCODING 178
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
40
a0
20
40
e0
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00b3
ENCODING 179
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
40
a0
40
20
c0
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00b4
ENCODING 180
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
00
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00b5
ENCODING 181
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
88
88
88
98
e8
80
00
ENDCHAR
STARTCHAR 00b6
ENCODING 182
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
78
e8
e8
e8
e8
68
28
28
28
00
00
ENDCHAR
STARTCHAR 00b7
ENCODING 183
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
30
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00b8
ENCODING 184
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
00
00
00
00
00
00
10
20
ENDCHAR
STARTCHAR 00b9
ENCODING 185
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
40
c0
40
40
e0
00
00
00
00
00
00
00
ENDCHAR
STARTCHAR 00ba
ENCODING 186
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
30
48
48
30
00
78
00
00
00
00
00
ENDCHAR
STARTCHAR 00bb
ENCODING 187
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
a0
50
28
28
50
a0
00
00
00
ENDCHAR
STARTCHAR 00bc
ENCODING 188
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
40
c0
40
40
e0
08
18
28
38
08
00
00
ENDCHAR
STARTCHAR 00bd
ENCODING 189
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
40
c0
40
40
e0
10
28
08
10
38
00
00
ENDCHAR
STARTCHAR 00be
ENCODING 190
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
40
a0
40
20
a0
48
18
28
38
08
00
00
ENDCHAR
STARTCHAR 00bf
ENCODING 191
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
20
00
20
20
40
80
88
88
70
00
00
ENDCHAR
STARTCHAR 00c0
ENCODING 192
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
20
50
88
88
f8
88
88
00
00
ENDCHAR
STARTCHAR 00c1
ENCODING 193
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
20
50
88
88
f8
88
88
00
00
ENDCHAR
STARTCHAR 00c2
ENCODING 194
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
20
50
88
88
f8
88
88
00
00
ENDCHAR
STARTCHAR 00c3
ENCODING 195
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
28
50
00
20
50
88
88
f8
88
88
00
00
ENDCHAR
STARTCHAR 00c4
ENCODING 196
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
20
50
88
88
f8
88
88
00
00
ENDCHAR
STARTCHAR 00c5
ENCODING 197
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
50
20
20
50
88
88
f8
88
88
00
00
ENDCHAR
STARTCHAR 00c6
ENCODING 198
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
58
a0
a0
a0
b0
e0
a0
a0
b8
00
00
ENDCHAR
STARTCHAR 00c7
ENCODING 199
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
70
88
80
80
80
80
80
88
70
20
40
ENDCHAR
STARTCHAR 00c8
ENCODING 200
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
f8
80
80
f0
80
80
f8
00
00
ENDCHAR
STARTCHAR 00c9
ENCODING 201
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
f8
80
80
f0
80
80
f8
00
00
ENDCHAR
STARTCHAR 00ca
ENCODING 202
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
60
90
00
f8
80
80
f0
80
80
f8
00
00
ENDCHAR
STARTCHAR 00cb
ENCODING 203
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
f8
80
80
f0
80
80
f8
00
00
ENDCHAR
STARTCHAR 00cc
ENCODING 204
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
f8
20
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00cd
ENCODING 205
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
f8
20
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00ce
ENCODING 206
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
f8
20
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00cf
ENCODING 207
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
f8
20
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00d0
ENCODING 208
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
f0
48
48
48
e8
48
48
48
f0
00
00
ENDCHAR
STARTCHAR 00d1
ENCODING 209
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
28
50
00
88
88
c8
a8
98
88
88
00
00
ENDCHAR
STARTCHAR 00d2
ENCODING 210
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
70
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00d3
ENCODING 211
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
70
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00d4
ENCODING 212
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
70
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00d5
ENCODING 213
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
28
50
00
70
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00d6
ENCODING 214
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
70
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00d7
ENCODING 215
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
88
50
20
50
88
00
00
00
ENDCHAR
STARTCHAR 00d8
ENCODING 216
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
08
70
98
98
a8
a8
a8
c8
c8
70
80
00
ENDCHAR
STARTCHAR 00d9
ENCODING 217
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
88
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00da
ENCODING 218
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
88
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00db
ENCODING 219
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
88
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00dc
ENCODING 220
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
88
88
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00dd
ENCODING 221
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
88
88
50
20
20
20
20
00
00
ENDCHAR
STARTCHAR 00de
ENCODING 222
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
80
f0
88
88
88
f0
80
80
80
00
00
ENDCHAR
STARTCHAR 00df
ENCODING 223
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
70
88
88
f0
88
88
c8
b0
80
00
ENDCHAR
STARTCHAR 00e0
ENCODING 224
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
00
70
08
78
88
98
68
00
00
ENDCHAR
STARTCHAR 00e1
ENCODING 225
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
70
08
78
88
98
68
00
00
ENDCHAR
STARTCHAR 00e2
ENCODING 226
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
00
70
08
78
88
98
68
00
00
ENDCHAR
STARTCHAR 00e3
ENCODING 227
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
28
50
00
00
70
08
78
88
98
68
00
00
ENDCHAR
STARTCHAR 00e4
ENCODING 228
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
00
70
08
78
88
98
68
00
00
ENDCHAR
STARTCHAR 00e5
ENCODING 229
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
30
00
70
08
78
88
98
68
00
00
ENDCHAR
STARTCHAR 00e6
ENCODING 230
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
28
70
a0
a8
50
00
00
ENDCHAR
STARTCHAR 00e7
ENCODING 231
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
00
70
88
80
80
88
70
20
40
ENDCHAR
STARTCHAR 00e8
ENCODING 232
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
00
70
88
f8
80
88
70
00
00
ENDCHAR
STARTCHAR 00e9
ENCODING 233
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
70
88
f8
80
88
70
00
00
ENDCHAR
STARTCHAR 00ea
ENCODING 234
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
00
70
88
f8
80
88
70
00
00
ENDCHAR
STARTCHAR 00eb
ENCODING 235
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
00
70
88
f8
80
88
70
00
00
ENDCHAR
STARTCHAR 00ec
ENCODING 236
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
00
60
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00ed
ENCODING 237
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
60
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00ee
ENCODING 238
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
00
60
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00ef
ENCODING 239
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
00
60
20
20
20
20
f8
00
00
ENDCHAR
STARTCHAR 00f0
ENCODING 240
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
20
60
10
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00f1
ENCODING 241
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
28
50
00
00
b0
c8
88
88
88
88
00
00
ENDCHAR
STARTCHAR 00f2
ENCODING 242
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
00
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00f3
ENCODING 243
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00f4
ENCODING 244
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
00
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00f5
ENCODING 245
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
28
50
00
00
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00f6
ENCODING 246
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
00
70
88
88
88
88
70
00
00
ENDCHAR
STARTCHAR 00f7
ENCODING 247
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
20
20
00
f8
00
20
20
00
00
00
ENDCHAR
STARTCHAR 00f8
ENCODING 248
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
00
08
70
98
a8
a8
c8
70
80
00
ENDCHAR
STARTCHAR 00f9
ENCODING 249
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
20
10
00
00
88
88
88
88
88
78
00
00
ENDCHAR
STARTCHAR 00fa
ENCODING 250
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
88
88
88
88
88
78
00
00
ENDCHAR
STARTCHAR 00fb
ENCODING 251
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
30
48
00
00
88
88
88
88
88
78
00
00
ENDCHAR
STARTCHAR 00fc
ENCODING 252
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
00
88
88
88
88
88
78
00
00
ENDCHAR
STARTCHAR 00fd
ENCODING 253
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
10
20
00
00
88
88
88
98
68
08
88
70
ENDCHAR
STARTCHAR 00fe
ENCODING 254
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
00
00
80
80
b0
c8
88
88
c8
b0
80
80
ENDCHAR
STARTCHAR 00ff
ENCODING 255
SWIDTH 461 0
DWIDTH 6 0
BBX 6 13 0 -2
BITMAP
00
50
50
00
00
88
88
88
98
68
08
88
70
ENDCHAR
ENDFONT
'! !


!SimpleTextState methodsFor: 'initialize-release'!
initialize
	"Initialize the receiver with empty contents."

	self initialize: (String new: 0)! !

!SimpleTextState methodsFor: 'initialize-release'!
initialize: aString
	"Initialize the receiver with the given contents."

	string _ aString.
	stringSize _ string size.
	fgRuns _ Array new: stringSize withAll: 0.
	bgRuns _ Array new: stringSize withAll: 7.
	emRuns _ Array new: stringSize withAll: 0.
	cursorCol _ 0.
	changed _ true.	"want initial display"
	selection _ nil.
	lastCol _ 0.! !

!SimpleTextState methodsFor: 'accessing'!
at: index insert: char fg: fg bg: bg em: em

	stringSize - 1 to: index by: -1 do: [:i |
		string at: i + 1 put: (string at: i).
		fgRuns at: i + 1 put: (fgRuns at: i).
		bgRuns at: i + 1 put: (bgRuns at: i).
		emRuns at: i + 1 put: (emRuns at: i)].
	string at: index put: char.
	self foregroundAt: index put: fg.
	self backgroundAt: index put: bg.
	lastCol _ lastCol + 1 min: stringSize max: index.
	changed _ true! !

!SimpleTextState methodsFor: 'accessing'!
at: index put: char fg: fg bg: bg em: em

	((string at: index) ~~ char
			or: [(fgRuns at: index) ~~ fg
			or: [(bgRuns at: index) ~~ bg
			or: [(emRuns at: index) ~~em]]])
		ifTrue:
			[string at: index put: char.
			 self foregroundAt: index put: fg.
			 self backgroundAt: index put: bg.
			 emRuns at: index put: em.
			 lastCol _ lastCol max: index.
			 changed _ true]! !

!SimpleTextState methodsFor: 'accessing'!
atAllPut: char fg: fg bg: bg em: em
	"Update the receiver's string, colour and emphasis."

	string from: 1 to: stringSize put: char.
	fgRuns from: 1 to: stringSize put: fg.
	bgRuns from: 1 to: stringSize put: bg.
	emRuns from: 1 to: stringSize put: em.
	lastCol _ char == $  ifTrue: [1] ifFalse: [stringSize].
	changed _ true! !

!SimpleTextState methodsFor: 'accessing'!
background: bgIndex

	1 to: stringSize do: [:i | self backgroundAt: i put: bgIndex]! !

!SimpleTextState methodsFor: 'accessing'!
backgroundAt: index put: c

	(bgRuns at: index) ~~ c
		ifTrue:
			[bgRuns at: index put: c.
			 changed _ true]! !

!SimpleTextState methodsFor: 'accessing'!
basicAt: index put: char fg: fg bg: bg em: em

	string at: index put: char.
	self foregroundAt: index put: fg.
	self backgroundAt: index put: bg.
	emRuns at: index put: em.
	lastCol _ lastCol max: index.! !

!SimpleTextState methodsFor: 'accessing'!
bgRuns

	^bgRuns! !

!SimpleTextState methodsFor: 'accessing'!
changed

	^changed! !

!SimpleTextState methodsFor: 'accessing'!
changed: aBoolean

	changed _ aBoolean! !

!SimpleTextState methodsFor: 'accessing'!
cursorCol: x

	cursorCol _ x.
	changed _ true! !

!SimpleTextState methodsFor: 'accessing'!
cursorColumn

	^cursorCol! !

!SimpleTextState methodsFor: 'accessing'!
deleteCharAt: index
	"Delete the character at index, moving anything to the right of it left one column."

	index to: stringSize - 1 do: [:i |
		string at: i put: (string at: i + 1).
		fgRuns at: i put: (fgRuns at: i + 1).
		bgRuns at: i put: (bgRuns at: i + 1).
		emRuns at: i put: (emRuns at: i + 1)].
	string at: stringSize put: $ .
	lastCol _ lastCol - 1 max: 0.
	changed _ true! !

!SimpleTextState methodsFor: 'accessing'!
emRuns

	^emRuns! !

!SimpleTextState methodsFor: 'accessing'!
fgRuns

	^fgRuns! !

!SimpleTextState methodsFor: 'accessing'!
foreground: fbIndex

	1 to: stringSize do: [:i | self foregroundAt: i put: fbIndex]! !

!SimpleTextState methodsFor: 'accessing'!
foregroundAt: index put: c

	(fgRuns at: index) ~~ c
		ifTrue:
			[fgRuns at: index put: c.
			 changed _ true]! !

!SimpleTextState methodsFor: 'accessing'!
from: start to: stop put: char fg: fg bg: bg em: em

	string from: start to: stop put: char.
	fgRuns from: start to: stop put: fg.
	bgRuns from: start to: stop put: bg.
	emRuns from: start to: stop put: em.
	changed _ true! !

!SimpleTextState methodsFor: 'accessing'!
insertAt: index

	stringSize - 1 to: index by: -1 do: [:i |
		string at: i + 1 put: (string at: i).
		fgRuns at: i + 1 put: (fgRuns at: i).
		bgRuns at: i + 1 put: (bgRuns at: i).
		emRuns at: i + 1 put: (emRuns at: i)].
	lastCol _ lastCol + 1 min: stringSize max: index.
	changed _ true! !

!SimpleTextState methodsFor: 'accessing'!
lastColumn
	"Answer the rightmost column into which a character has been explicitly written."

	^lastCol! !

!SimpleTextState methodsFor: 'accessing'!
lastColumn: col
	"Somebody has deleted everythig from col onwards."

	lastCol _ col! !

!SimpleTextState methodsFor: 'accessing'!
selection
	"Answer the selection range for this line."

	^selection! !

!SimpleTextState methodsFor: 'accessing'!
setWidth: width

	string size < width
		ifTrue: [self string: (string forceTo: width paddingWith: $ )]
		ifFalse: [string size > width
			ifTrue: [self from: width + 1 to: string size  put: $  fg: 0 bg: 7 em: 0]].
	stringSize _ width.
	self findLastColumn.! !

!SimpleTextState methodsFor: 'accessing'!
string

	^string! !

!SimpleTextState methodsFor: 'accessing'!
string: aString
	"Replace the receiver's string with aString.  If the receiver changes width then also modify the colours and emphasis retaining the overlapping portions and extending with default colours and emphasis, and then update the geometry.  Reset lastCol to be the index of the last non-whitespace in aString."

	| oldSize newSize |
	oldSize _ string size.
	newSize _ aString size.
	string _ aString.
	oldSize < newSize
		ifTrue:
			[fgRuns _ fgRuns forceTo: newSize paddingWith: 0.
			 bgRuns _ bgRuns forceTo: newSize paddingWith: 7.
			 emRuns _ emRuns forceTo: newSize paddingWith: 0]
		ifFalse:
			[fgRuns from: newSize + 1 to: oldSize put: 0.
			 bgRuns from: newSize + 1 to: oldSize put: 7.
			 emRuns from: newSize + 1 to: oldSize put: 0].
	cursorCol _ cursorCol min: newSize.
	stringSize _ newSize.
	self findLastColumn.
	selection _ nil! !

!SimpleTextState methodsFor: 'accessing'!
stringSize

	^stringSize! !

!SimpleTextState methodsFor: 'copying'!
copy

	^self deepCopy! !

!SimpleTextState methodsFor: 'selection'!
appendSelectionTo: aStream

	selection isNil ifTrue: [^self].	"no selection"
	selection first > lastCol ifTrue: [^aStream cr].	"only the end of line is selected"
	selection first to: (selection last min: lastCol) do: [:i | aStream nextPut: (string at: i)].	"line contents are selected"
	selection last > lastCol ifTrue: [aStream cr].	"end of line is included in selection"! !

!SimpleTextState methodsFor: 'selection'!
clearSelection

	selection isNil ifTrue: [^self].
	selection first to: selection last do: [:i | emRuns at: i put: ((emRuns at: i) bitXor: 64)].
	selection _ nil.
	changed _ true! !

!SimpleTextState methodsFor: 'selection'!
findFirstInClass: charClasses from: start
	"Find the index of the leftmost character in the sequence of characters beginning at start that all belong to the same class in charClasses."

	| charClass |
	charClass _ charClasses at: (string at: start) asciiValue + 1.
	start - 1 to: 1 by: -1 do: [ :i | (charClasses at: (string at: i) asciiValue + 1) == charClass ifFalse: [^i + 1]].
	^1.! !

!SimpleTextState methodsFor: 'selection'!
findLastInClass: charClasses from: start
	"Find the index of the rightmost character in the sequence of characters beginning at start that all belong to the same class in charClasses."

	| charClass |
	charClass _ charClasses at: (string at: start) asciiValue + 1.
	start + 1 to: lastCol do: [ :i | (charClasses at: (string at: i) asciiValue + 1) == charClass ifFalse: [^i - 1]].
	^lastCol.! !

!SimpleTextState methodsFor: 'selection'!
selectFrom: left to: right

	selection isNil ifFalse: [self clearSelection].
	selection _ Array with: left with: right.
	left to: right do: [:i | emRuns at: i put: ((emRuns at: i) bitXor: 64)].
	changed _ true! !

!SimpleTextState methodsFor: 'selection'!
selectionSpansColumn: index
	"Answer whether index is inside the current selection range."

	^selection notNil and: [index >= selection first and: [index <= selection last]]! !

!SimpleTextState methodsFor: 'private'!
findLastColumn

	stringSize to: 1 by: -1 do: [ :i | (string at: i) == $  ifFalse: [^lastCol _ i]].
	^lastCol _ 0.! !


!SimpleTextState class methodsFor: 'instance creation'!
new

	^super new initialize! !

!SimpleTextState class methodsFor: 'instance creation'!
new: size

	^self string: (String new: size withAll: $ )! !

!SimpleTextState class methodsFor: 'instance creation'!
string: aString

	^super new initialize: aString! !


!StatefulProtocol methodsFor: 'accessing'!
client: anObject

	client _ anObject! !

!StatefulProtocol methodsFor: 'accessing'!
initialState: stateNode

	currentState _ stateNode.
	self client: self! !

!StatefulProtocol methodsFor: 'accessing'!
state

	^currentState! !

!StatefulProtocol methodsFor: 'protocol'!
upcall: anObject

	currentState _ (currentState transitionAt: anObject)
		transitionFrom: currentState for: client with: anObject! !


!StatefulProtocol class methodsFor: 'instance creation'!
initialState: stateNode

	^self new initialState: stateNode! !

!StatefulProtocol class methodsFor: 'instance creation'!
initialState: stateNode client: aClient

	^self new initialState: stateNode; client: aClient! !


!StatefulProtocolDescription methodsFor: 'initialize-release'!
initialState: stateName

	initialState _ stateName! !

!StatefulProtocolDescription methodsFor: 'initialize-release'!
newState: rule

	^self newState: rule key default: rule value! !

!StatefulProtocolDescription methodsFor: 'initialize-release'!
newState: stateName default: transition

	^self at: stateName put: (ProtocolState name: stateName default: transition)! !

!StatefulProtocolDescription methodsFor: 'printing'!
printElementsOn: aStream

	aStream nextPutAll: '(initial: ' , initialState printString , ' states:'.
	self keysDo: [:key | aStream space.  key printOn: aStream].
	aStream nextPut: $)! !

!StatefulProtocolDescription methodsFor: 'compiling'!
compile
	"Compile my symbolic representation into a cyclic DAG and answer the root node"

	| edge |
	self valuesDo: [:state |
		state defaultTransition: (self resolve: state default).
		state keysDo: [:key |
			edge _ state at: key.
			state transitionAt: key put: (self resolve: edge)]].
	
	^self at: initialState! !

!StatefulProtocolDescription methodsFor: 'compiling'!
resolve: edge

	| target action |
	target _ edge state.
	action _ edge action.
	target _ (self includesKey: target)
		ifTrue: [self at: target]
		ifFalse: [target isNil
					ifTrue: [nil]
					ifFalse: [self error: 'unknown target state ' , edge printString]].
	^ProtocolStateTransition action: action state: target! !


!StatefulProtocolDescription class methodsFor: 'instance creation'!
initialState: stateName

	^self new initialState: stateName! !

!StatefulProtocolDescription class methodsFor: 'examples'!
example
	"A state machine that recognises occurrences of 'x' 'xy' and 'xy[digits...]z' in a stream of characters.  Note: this is used by StateMachineTester, so don't modify it.  See StateMachineTester class>>test for an example of use."
	"StatefulProtocolDescription example"

	| desc |
	desc _ self new.
	(desc newState: #initial -> (#echo: -> #initial)) add: $x -> (nil -> #statex).
	(desc newState: #statex -> (#echox: -> #initial)) add: $y -> (#initPrefix: -> #statexy).
	(desc newState: #statexy -> (#echoxy: -> #initial))
		add: $z -> (#echoxyz: -> #initial);
		addAll: '0123456789' -> (#addPrefix: -> nil).
	desc initialState: #initial.
	^desc! !

!StatefulProtocolDescription class methodsFor: 'examples'!
example2
	"StatefulProtocolDescription example2 explore"

	^self example compile! !

!StatefulProtocolDescription class methodsFor: 'examples'!
example3		"Note: this example should pop up an error notifier during compilation"

	"StatefulProtocolDescription example3 compile"

	| desc |
	desc _ self new.
	(desc newState: #initial -> (#echo: -> #initial)) add: $x -> (nil -> #statex).
	(desc newState: #statex -> (#echox: -> #initial)) add: $y -> (nil -> #statexy).
	(desc newState: #statexy -> (#echoxy: -> #initial)) add: $z -> (#echoxy: -> #statexyz).
	desc initialState: #initial.
	^desc! !


!StatefulProtocolTester methodsFor: 'state transitions'!
step: anObject
	Transcript cr;
		print: currentState name;
		nextPutAll: ' step: ';
		print: anObject;
		nextPutAll: ' -> ';
		endEntry.
	self upcall: anObject.! !

!StatefulProtocolTester methodsFor: 'actions'!
addPrefix: anObject

	prefix _ prefix * 10 + anObject asInteger - 48! !

!StatefulProtocolTester methodsFor: 'actions'!
echo: anObject

	Transcript show: anObject printString! !

!StatefulProtocolTester methodsFor: 'actions'!
echox: anObject

	Transcript show: ' <saw X> ' , anObject printString! !

!StatefulProtocolTester methodsFor: 'actions'!
echoxy: anObject

	Transcript show: ' <saw XY> ' , anObject printString! !

!StatefulProtocolTester methodsFor: 'actions'!
echoxyz: anObject

	Transcript show: ' <saw XYZ prefix ' , prefix printString , ' > ' , anObject printString! !

!StatefulProtocolTester methodsFor: 'actions'!
initPrefix: anObject

	prefix _ 0! !


!StatefulProtocolTester class methodsFor: 'examples'!
test
	"StatefulProtocolTester test"

	| sm input |
	sm _ self initialState: (StatefulProtocolDescription example compile).
	sm client: sm.
	input _ '1x2xx3xxx4y5xy6yy7xyx8xyy9xyz10zyx'.
	Transcript cr; show: 'input is ' , input printString ; cr.
	'1x2xx3xxx4y5xy6yy7xyx8xyy9xyz10xy42zzyx' do: [: c | sm step: c].
	Transcript cr; show: ' final state is ' , sm state name printString; cr.! !


!StatefulProtocolTester2 methodsFor: 'initialize-release'!
reset

	e _ x _ xy _ xyz _ 0! !

!StatefulProtocolTester2 methodsFor: 'actions'!
echo: anObject

	e _ e + 1! !

!StatefulProtocolTester2 methodsFor: 'actions'!
echox: anObject

	x _ x + 1! !

!StatefulProtocolTester2 methodsFor: 'actions'!
echoxy: anObject

	xy _ xy + 1! !

!StatefulProtocolTester2 methodsFor: 'actions'!
echoxyz: anObject

	xyz _ xyz + 1! !

!StatefulProtocolTester2 methodsFor: 'printing'!
printOn: aStream

	aStream cr; nextPutAll: 'saw ',
		e printString, ' unmatched characters, ',
		x printString, ' x, ',
		xy printString, ' xy, ',
		xyz printString, ' xyz'.! !


!StatefulProtocolTester2 class methodsFor: 'examples'!
test
	"A version of StatefulProtocolTester that measures throughput (in transitions per second)."

	"StatefulProtocolTester2 test"

	| sm input stream size time |
	sm _ self initialState: (StatefulProtocolDescription example compile).
	sm client: sm.
	input _ '1x2xx3xxx4y5xy6yy7xyx8xyy9xyz10zyx'.
	Transcript cr; show: 'input is ' , input printString ; cr.
	stream _ WriteStream on: input.
	[stream contents size < 100000] whileTrue: [stream nextPutAll: input].
	Transcript show: 'size is ' , (size _ stream contents size) printString; cr.
	input _ ReadStream on: stream contents.
	time _ Time millisecondsToRun: [sm reset; upcallAll: input].
	Transcript show: sm printString , ' in ' , time printString , 'ms'; cr.
	Transcript show: (size / time * 1000) asInteger printString,
		' state transitions per second'! !


!StrikeFont methodsFor: 'testing'!
isMonospaced
	| widths |
	widths _ ((0 to: 255) collect: [ :n | self widthOf: (Character value: n) ]) asBag.
	^(widths sortedElements reject: [ :a | a key == 0 ]) size < 3! !


!StrikeFont class methodsFor: 'accessing'!
monospacedFamilyNames
	| retval |
	retval _ Set new.
	(TextConstants select: [ :ea | ea isKindOf: TextStyle ]) do: [ :family |
		retval addAll: ((family fonts select: [ :font | font isMonospaced ]) collect: [ :font | font familyName asSymbol ])
	].
	^retval! !


!TeletypeMorph methodsFor: 'initialize-release'!
initialize

	^self initialize: 80@24! !

!TeletypeMorph methodsFor: 'initialize-release'!
initialize: size

	super initialize.
	borderWidth _ 2.
	color _ Color white.
	inset _ 2.
	trackingSelection _ false.
	useScrollbar _ false.
	self
		initializeTeletype: size;
		initializeContent;
		initializeScrollbar;
		extent: self preferredExtent! !

!TeletypeMorph methodsFor: 'initialize-release'!
initializeContent

	| morphs |
	morphs _ OrderedCollection new.
	rows timesRepeat: [morphs addLast: ((SimpleTextMorph contents: (lines addLast: self newLine)) cursorColour: cursorColour)].
	self addAllMorphs: morphs.
	topLine _ 1.
	bottomLine _ rows.
	x _ y _ 1.
	self banner do: [:c | self upcall: c asInteger]! !

!TeletypeMorph methodsFor: 'initialize-release'!
initializeScrollbar

	scrollFlop _ (Preferences valueOfFlag: #inboardScrollbars) not.
	scrollRight _ (Preferences valueOfFlag: #scrollBarsOnRight).
	useScrollbar & scrollFlop not ifTrue: [self showScrollbar]! !

!TeletypeMorph methodsFor: 'initialize-release'!
initializeTabs

	tabs _ Array new: cols withAll: false.
	1 to: cols by: 8 do: [:i | tabs at: i put: true]! !

!TeletypeMorph methodsFor: 'initialize-release'!
initializeTeletype: size
	"Initialize the default behaviour: dumb terminal with local echo and default xterm VT options."

	font _ (TextConstants at: (SimpleTextMorph defaultFont)) defaultFont.
	pitch _ font widthOf: $m.
	skip _ font height.
	cols _ size x.  rows _ size y.
	lines _ OrderedCollection new.
	savedLines _ 0.
	savedLineLimit _ SavedLineLimit.
	displayStart _ 0.
	x _ 1.  y _ 1.
	fg _ 0.  bg _ 7.  em _ 0.
	rv _ false.  ec _ false.
	session _ nil.
	self initializeTabs.
	self initializeTerminalModes.
	"Default low protocol: local echo"
	down _ (ProtocolAdaptor new localEcho up: self).
	showCursor _ true.
	running _ false.
	autoFlush _ 0.
	steps _ 0.
	altScreenActive _ false.
	altScreenColours _ false.
	hasFocus _ true.
	selectionStart _ selectionEnd _ nil.
	selectionActive _ false.
	selection _ ''.
	mouseControlsSelection _ MouseControlsSelection.
	keyboardControlsSelection _ KeyboardControlsSelection.
	scrollOnInput _ false.
	scrollOnOutput _ true.
	allow132 _ true.
	characterClasses _ CharClass copy.
	cursorColour _ nil.! !

!TeletypeMorph methodsFor: 'initialize-release'!
initializeTerminalModes
	"Initialize the default behaviour: dumb terminal with local echo and standard xterm VT option settings."

	autoWrap _ true.
	reverseWrap _ autoLinefeed _ autoCR _ relativeOrigin _ insertMode _ false.
	showCursor _ true.
	smoothScroll _ false.
	metaSendsEscape _ true.
	deleteIsDel _ false.
	altScreenSwitch _ true.
	reverseVideo _ false.! !

!TeletypeMorph methodsFor: 'initialize-release'!
openInWorld

	self currentHand newKeyboardFocus: nil.
	super openInWorld.
! !

!TeletypeMorph methodsFor: 'initialize-release'!
session: aSession

	session _ aSession! !

!TeletypeMorph methodsFor: 'initialize-release'!
setWindow: aWindow

	systemWindow _ aWindow! !

!TeletypeMorph methodsFor: 'accessing'!
activeColumn

	^x! !

!TeletypeMorph methodsFor: 'accessing'!
activeColumn: c

	x _ c min: cols.
	self showCursor.! !

!TeletypeMorph methodsFor: 'accessing'!
bufferState
	"Answer an opaque representation of the current state of the buffer contents."

	| theLines state |
	self clearSelection.
	theLines _ OrderedCollection new.
	self linesDo: [:line | theLines addLast: line copy].
	state _ Array with: theLines asArray with: rv with: altScreenActive with: x with: y with: cursorColour.
	altScreenActive _ true.
	^state! !

!TeletypeMorph methodsFor: 'accessing'!
bufferState: state
	"Restore the buffer contents to a previously saved state."

	| theLines nRows |
	altScreenSwitch ifFalse: [^self].
	self clearSelection; clearCursor.
	theLines _ state at: 1.
	rv _ state at: 2.
	altScreenActive _ state at: 3.
	"Ensure we have sufficient lines in the display."
	[lines size < theLines size]
		whileTrue:
			[lines addLast: (SimpleTextState new: cols).
			 self addMorphBack: (SimpleTextMorph contents: lines last)].
	nRows _ rows min: theLines size.
	1 to: nRows do: [ :i |
		(submorphs at: i)
			lineState:
			(self displayLineAt: i put:
				((theLines at: i) setWidth: cols))].
	nRows + 1 to: rows do: [:i | self clearLine: i from: 1 to: cols].
	submorphs from: 1 to: rows do: [ :m | m rv: (rv xor: reverseVideo)].
	x _ (state at: 4) min: cols max: 1.
	y _ (state at: 5) min: rows max: 1.
	cursorColour _ state at: 6.
	self showCursor; linesChanged; changed! !

!TeletypeMorph methodsFor: 'accessing'!
characterClass

	^CharClass! !

!TeletypeMorph methodsFor: 'accessing'!
columns

	^cols! !

!TeletypeMorph methodsFor: 'accessing'!
deleteIsDel

	^deleteIsDel! !

!TeletypeMorph methodsFor: 'accessing'!
deleteIsDel: aBoolean

	deleteIsDel _ aBoolean! !

!TeletypeMorph methodsFor: 'accessing'!
graphicsState
	"Answer an opaque representation of the current character attributes."

	^Array with: fg with: bg with: em with: rv! !

!TeletypeMorph methodsFor: 'accessing'!
graphicsState: gs
	"Restore the current character attributes.  (See #graphicsState.)"

	fg _ gs at: 1.
	bg _ gs at: 2.
	em _ gs at: 3! !

!TeletypeMorph methodsFor: 'accessing'!
hasFocus

	^hasFocus! !

!TeletypeMorph methodsFor: 'accessing'!
metaSendsEscape

	^metaSendsEscape! !

!TeletypeMorph methodsFor: 'accessing'!
pitch

	^pitch! !

!TeletypeMorph methodsFor: 'accessing'!
rows

	^rows! !

!TeletypeMorph methodsFor: 'accessing'!
rv: aBoolean
	"Set the programmed reverse video flag.  Not to be confused with reverseVideo, which is a user preference that inverts the sense of the programmed change."

	rv == aBoolean ifTrue: [^self].
	rv _ aBoolean..
	submorphs from: 1 to: rows do: [ :m | m rv: (rv xor: reverseVideo)].
	self changed! !

!TeletypeMorph methodsFor: 'accessing'!
skip

	^skip! !

!TeletypeMorph methodsFor: 'testing'!
isCollapsed

	^(systemWindow notNil) and: [systemWindow isCollapsed]! !

!TeletypeMorph methodsFor: 'events'!
handlesKeyboard: evt
	"Answer whether we're interested in keyboard events."

	^true "hasFocus or: [super handlesKeyboard: evt]"! !

!TeletypeMorph methodsFor: 'events'!
handlesMouseDown: evt
	"Answer whether we're interested in mouse events."

	^true "self isConnected and: [hasFocus or: [super handlesMouseDown: evt]]"! !

!TeletypeMorph methodsFor: 'events'!
handlesMouseOver: evt

	^true "hasFocus or: [super handlesMouseOver: evt]"! !

!TeletypeMorph methodsFor: 'events'!
keyStroke: evt
	"Receive a character from the keyboard."

	| char |
	scrollOnInput ifTrue: [self pageEnd].
	char _ evt keyCharacter asciiValue.
	evt controlKeyPressed
		ifFalse:
			[char == 1 ifTrue: [^self pageHome].
			 char == 4 ifTrue: [^self pageEnd].
			 char == 11 ifTrue: [^self pageUp: rows // 2].
			 char == 12 ifTrue: [^self pageDown: rows // 2]].
	(keyboardControlsSelection and: [evt commandKeyPressed])
		ifTrue:
			[evt keyCharacter == $c ifTrue: [^self copySelection].
			 evt keyCharacter == $v ifTrue: [^self sendSelection]].
	(metaSendsEscape and: [evt commandKeyPressed])
		ifTrue: [down downcall: Character escape asciiValue].
	"Cursor keys clash with control keys: differentiate by sending 128+cursorKeyCode."
	(char == 8 & deleteIsDel and: [evt controlKeyPressed not]) ifTrue: [char _ 127].
	(char < 32 and: [evt controlKeyPressed not]) ifTrue: [char _ char + 128].
	down downcall: char.
	evt wasHandled: true.! !

!TeletypeMorph methodsFor: 'events'!
keyboardFocusChange: aBoolean

	hasFocus _ aBoolean! !

!TeletypeMorph methodsFor: 'events'!
lock
	"We're losing keyboard focus."

	super lock.
	hasFocus _ false.
	self changed.! !

!TeletypeMorph methodsFor: 'events'!
mouseDown: evt
	"A mouse button has been pressed."

"	evt printString displayAt: 10@200.
"
	evt hand newKeyboardFocus: self.

	"Yellow button is menu (or selection send when in xterm mode)."
	(evt yellowButtonChanged)
		ifTrue:
			[(mouseControlsSelection and: [evt anyModifierKeyPressed not])
				ifTrue: [self sendSelection]
				ifFalse: [(systemWindow isKindOf: TeletypeWindow)
					ifTrue: [systemWindow offerWindowMenu]
					ifFalse: [self offerVTMenu]].
			 ^super mouseDown: evt].

	"Red button is selection start (or selection extend when shifted in Squeak mode)."
	(evt redButtonChanged)
		ifTrue:
			[evt shiftPressed
				ifTrue: ["mouseControlsSelection not and:" self extendSelection: evt position]
				ifFalse: [self startSelection: evt position].
			 ^super mouseDown: evt].

	"Blue button is selection extend when in xterm mode."
	(mouseControlsSelection and: [evt blueButtonChanged])
		ifTrue:
			[self extendSelection: evt position.
			 ^super mouseDown: evt].

	super mouseDown: evt.! !

!TeletypeMorph methodsFor: 'events'!
mouseEnter: evt
	"The pointer just entered the window."

	TextCursor beCursor.
	useScrollbar & scrollFlop ifTrue: [self showScrollbar].
	super mouseEnter: evt! !

!TeletypeMorph methodsFor: 'events'!
mouseLeave: evt
	"The cursor just left the window."

	Cursor normal show.
	useScrollbar & scrollFlop ifTrue: [self hideScrollbar].
	super mouseLeave: evt! !

!TeletypeMorph methodsFor: 'events'!
mouseMove: evt
	"The mouse is moving inside the window."

"	evt printString displayAt: 10@220.
"
	evt redButtonPressed ifTrue: [self trackSelection: evt position].
	super mouseMove: evt! !

!TeletypeMorph methodsFor: 'events'!
mouseUp: evt
	"A mouse button has been released."

"	evt printString displayAt: 10@240.
"
	evt redButtonChanged ifTrue: [self endSelection: evt position].
	evt wasHandled: true! !

!TeletypeMorph methodsFor: 'events'!
unlock
	"We're acquiring keyboard focus."

	super unlock.
	hasFocus _ true.
	self changed.! !

!TeletypeMorph methodsFor: 'events'!
wouldAcceptKeyboardFocus
	"Of course we would."

	^true! !

!TeletypeMorph methodsFor: 'selection'!
clearSelection
	"Remove the visual representation of the selection region.  Saved selection text is unaffacted."

	selectionActive ifFalse: [^self].
	lines do: [:line | line clearSelection].
	selectionActive _ false.
	"self changed"! !

!TeletypeMorph methodsFor: 'selection'!
copySelection
	"Copy the currently selected text to the clipboard."

	Clipboard clipboardText: selection! !

!TeletypeMorph methodsFor: 'selection'!
endSelection: screenPosition
	"Mouse selection has just finished.  Stop tracking and, iff the mouse moved since selection start, compute and remember the new selection text."

	self stopSteppingSelector: #trackSelection.
	self showCursor; changed.
	selectionEnd isNil ifTrue: [^nil].
	self saveSelection.
	screenPosition = mousePosition ifFalse: [selectionEnd _ nil]! !

!TeletypeMorph methodsFor: 'selection'!
extendSelection: screenPosition
	"Extend the current selection through screenPosition."

	selectionStart isNil ifFalse: [self trackSelection: screenPosition]! !

!TeletypeMorph methodsFor: 'selection'!
getSelectionRegion
	"Answer a Rectangle representing the current selection area in character coordinates.  Note that the origin may be to the right of the corner."

	| start end tmp |
	(start _ selectionStart) y > (end _ selectionEnd) y ifTrue: [start _ selectionEnd.  end _ selectionStart].
	(start y == end y and: [start x > end x]) ifTrue: [tmp _ start.  start _ end.  end _ tmp].
	"start now guaranteed to be before end in screen"
	"we don't include the character under selectionStart"
	end _ end - (1@0).
	^Rectangle origin: start corner: end! !

!TeletypeMorph methodsFor: 'selection'!
highlightSelection
	"The selection region has changed.  Update the visual representation."

	| region |
	region _ self getSelectionRegion.
	lines do: [ :line | line clearSelection].
	region height == 0		"single line"
		ifTrue:
			[(lines at: region top) selectFrom: region left to: region right]
		ifFalse:
			[(lines at: region top) selectFrom: region left to: cols.
			 lines from: region top + 1 to: region bottom - 1 do: [:line | line selectFrom: 1 to: cols].
			 (lines at: region bottom) selectFrom: 1 to: region right].
	selectionActive _ true.
	self changed! !

!TeletypeMorph methodsFor: 'selection'!
saveSelection
	"A new selection has been made.  Compute and remember the selection text."

	| stream region |
	region _ self getSelectionRegion.
	stream _ WriteStream on: String new.
	lines from: region top to: region bottom do: [:line | line appendSelectionTo: stream].
	selection _ stream contents.
	mouseControlsSelection ifTrue: [Clipboard clipboardText: selection].! !

!TeletypeMorph methodsFor: 'selection'!
selectLine: screenPosition
	"Triple click.  Select the line surrounding the cursor, including the end of line, and save the selection text."

	| pos |
"
	'select line   ' displayAt: 10@130.
"
	pos _ self selectionPositionAt: screenPosition.
	selectionStart _ 1 @ pos y.
	selectionEnd _ cols + 1 @ pos y.
	self highlightSelection; saveSelection.
	selectionEnd _ nil.
	mousePosition _ nil.! !

!TeletypeMorph methodsFor: 'selection'!
selectWord: screenPosition
	"Double click.  Select the word surrounding the cursor according to the current char class and save the selection text."

	| pos line left right |
"
	'select word   ' displayAt: 10@130.
"
	pos _ self selectionPositionAt: screenPosition.
	line _ lines at: pos y.
	left _ line findFirstInClass: self characterClass from: (pos x min: cols).
	right _ line findLastInClass: self characterClass from: (pos x min: cols).
	selectionStart _ left @ pos y.
	selectionEnd _ right + 1 @ pos y.
	right < left
		ifTrue: [self clearSelection]
		ifFalse: [self highlightSelection; saveSelection]! !

!TeletypeMorph methodsFor: 'selection'!
selectionPositionAt: screenPosition
	"Answer a Point in character coordinates corresponding to the given position in screen coordinates.  If screenPosition is above the window, try to scroll up before answering the first character in the window.  If screenPosition is below the window, try to scroll down before answering one character right of the last character in the window."

	| pos |
	screenPosition y < (self submorphs at: 1) bounds top
		ifTrue:
			[self pageUp: (rows // 8 max: 1).
			 ^1 @ (displayStart + 1)].
	screenPosition y > (self submorphs at: rows) bounds bottom
		ifTrue:
			[self pageDown: (rows // 8 max: 1).
			 ^(cols + 1) @ (displayStart + rows)].
	1 to: rows do: [:i
		| (pos _ (self submorphs at: i) selectionColumnAt: screenPosition) isNil
			ifFalse: [^pos @ (displayStart + i)]].
	^nil! !

!TeletypeMorph methodsFor: 'selection'!
sendSelection
	"Send the clipboard text to the application."

	down downcallAll: Clipboard clipboardText asString asByteArray! !

!TeletypeMorph methodsFor: 'selection'!
startSelection: screenPosition
	"Mouse selection has begun.  If this is a double click (mouse hasn't moved since last click and selectionEnd isNil) then select the word under the pointer.  If this is a triple click (mouse hasn't moved and selectionEnd notNil after prior word selection) then select the line under the pointer.  Otherwise clear the current selectionStart and begin tracking."

	| start |
	self hideCursor; changed.
	mousePosition = screenPosition
		ifTrue:
			[^selectionEnd isNil
				ifTrue: [self selectWord: screenPosition]
				ifFalse: [self selectLine: screenPosition]].
"
	'mouse position ' , mousePosition printString,
	' screen position ', screenPosition printString, 
	' selectionEnd ', selectionEnd printString, 
	'  ' displayAt: 10@150.
"
	mousePosition _ screenPosition.
	selectionEnd _ nil.

	start _ self selectionPositionAt: screenPosition.
	self clearSelection.
	selectionStart _ start.
"
	'selection begin ', selectionStart printString, '     ' displayAt: 10@10
"! !

!TeletypeMorph methodsFor: 'selection'!
trackSelection
	"The mouse is down during selection tracking.  Update the visual representation of the selected region."

	| pos |
	(pos _ self selectionPositionAt: Sensor cursorPoint) isNil
		ifFalse:
			[selectionEnd _ pos.
			 self highlightSelection]! !

!TeletypeMorph methodsFor: 'selection'!
trackSelection: screenPosition
	"The mouse moved during selection tracking.  Update the visual representation of the selected region."

	(trackingSelection or: [(self selectionPositionAt: screenPosition) isNil])
		ifFalse: [self
				startStepping: #trackSelection
				at: Time millisecondClockValue
				arguments: #()
				stepTime: 100]! !

!TeletypeMorph methodsFor: 'geometry'!
extent: newExtent
	"We're being allocated real estate from above (initial placement or manual resize).  Adjust the screen size accordingly."

	| layoutBounds textBounds nCols nRows org ext lineSkip |
	super extent: newExtent.
	layoutBounds _ self layoutBounds.
	textBounds _ self textBounds: layoutBounds.
	nCols _ textBounds width // pitch.
	nRows _ textBounds height // skip.
	self hideScrollbar; initTextBounds: textBounds width: nCols height: nRows.
	org _ textBounds topLeft.
	ext _ (cols * pitch) @ skip.
	lineSkip _ 0 @ skip.
	submorphs doWithIndex: [:m :i |
		m bounds: (org extent: ext).
		org _ org translateBy: lineSkip].
	(useScrollbar and: [scrollFlop not]) ifTrue: [self showScrollbar].! !

!TeletypeMorph methodsFor: 'geometry'!
hideScrollbar
	"Remove the scrollbar from the window."

	scroll notNil
		ifTrue:
			[scroll delete.
			 scroll _ nil]! !

!TeletypeMorph methodsFor: 'geometry'!
initScrollbar: frame
	"Initialize the scrollbar to fit in/around the given frame."

	| width extent origin |
	width _ self scrollbarWidth.
	scrollFlop
		ifFalse:
			[extent _ (width) @ (frame height).
			 origin _ scrollRight
				ifFalse: [frame origin]
				ifTrue: [(frame right - width) @ (frame top)]]
		ifTrue:
			[extent _ (width + borderWidth) @ (frame height + (borderWidth * 2)).
			 origin _ scrollRight
				ifFalse: [(frame left - width - borderWidth) @ (frame top - borderWidth)]
				ifTrue: [(frame right) @ (frame top - borderWidth)]].
	scroll bounds: (origin extent: extent)! !

!TeletypeMorph methodsFor: 'geometry'!
initTextBounds: textBounds width: nCols height: nRows
	"This is a geometry change imposed from outside (either initial placement or manual resizing).  We honour it without attempting to fix the geometry of our owner."

	| r morphs morph |
	(nCols == cols and: [nRows == rows]) ifTrue: [^self].
	morphs _ OrderedCollection withAll: submorphs.	"copy".
	self clearSelection; hideCursor; removeAllMorphs.
	cols _ nCols max: 1.
	x _ x min: cols.
	lines do: [ :line | line setWidth: cols].
	r _ nRows max: 1.
	[rows < r]
		whileTrue:
			[displayStart > 0
				ifTrue:
					["suck last saved line back down into the screen"
					 displayStart _ displayStart - 1.
					 savedLines _ savedLines - 1.
					 morphs addFirst: (SimpleTextMorph contents: (self displayLineAt: 1)).
					 y _ y + 1]
				ifFalse:
					["add a new empty line at the bottom of the screen"
					 morph _ SimpleTextMorph contents: (lines addLast: (SimpleTextState new: cols)).
					 morphs addLast: morph].
			 rows _ rows + 1].
	[rows > r]
		whileTrue:
			[rows _ rows - 1.
			 savedLines _ savedLines + 1.
			 displayStart _ displayStart + 1.
			 morphs removeLast.
			 y _ y - 1 max: 1].
	self
		addAllMorphs: morphs;
		showCursor;
		doSoftReset;
		initializeTabs;
		reportSizeToSession;
		linesChanged.
	"morphic explodes if we continue before making absolutely sure the window is redrawn..."
	"(running and: [self world notNil]) ifTrue: [self world doOneCycle]"! !

!TeletypeMorph methodsFor: 'geometry'!
initialExtent

	self flag: #ikp. "can this can go away?"
	^self preferredExtent! !

!TeletypeMorph methodsFor: 'geometry'!
preferredExtent
	"Answer the extent that we would be given in an ideal world (no pun intended).  This is just the amout of space we need to display our contents, and no more."

	| w h s |
	s _ (useScrollbar and: [scrollFlop not]) ifTrue: [self scrollbarWidth] ifFalse: [0].
	w _ borderWidth + s + inset + (cols * pitch) + inset + borderWidth.
	h _ borderWidth + inset + (rows * skip) + inset + borderWidth.
	^w@h! !

!TeletypeMorph methodsFor: 'geometry'!
scrollbarWidth

	^ScrollPane new scrollbarWidth! !

!TeletypeMorph methodsFor: 'geometry'!
setWidth: nCols height: nRows
	"This is a programmed geometry change.  We try to honour it by figuring out the corresponding geometry change required in our owner in order to acheive the given number of cols and rows.  The actual change takes place on the flip side, when our owner sends down our new extent."

	| flak |
	(cols == nCols and: [rows == nRows]) ifTrue: [^self].
	flak _ systemWindow isNil ifTrue: [0] ifFalse: [systemWindow fullBounds extent - self textBounds extent].
	"self changed; sync."
	(systemWindow isNil ifTrue: [self] ifFalse: [systemWindow])
		extent: (pitch * nCols) @ (skip * nRows) + flak.
	"self sync."! !

!TeletypeMorph methodsFor: 'geometry'!
showScrollbar
	"Add a scrollbar to the window."

	scroll isNil
		ifTrue:
			[scroll _ ScrollBar new model: self slotName: 'scrollbar'; initializeEmbedded: scrollFlop not.
			 self
				addMorphBack: scroll;
				initScrollbar: self layoutBounds;
				updateScrollbar]! !

!TeletypeMorph methodsFor: 'geometry'!
textBounds
	"Answer just the bounds of the text -- excluding border, scroll and inset."

	^self textBounds: self layoutBounds! !

!TeletypeMorph methodsFor: 'geometry'!
textBounds: outer
	"Answer just the bounds of the text -- excluding border, scroll and inset."

	| width left right inner |
	left _ right _ 0.
	(useScrollbar & scrollFlop not)
		ifTrue:
			[width _ self scrollbarWidth.
			 scrollRight ifTrue: [right _ width] ifFalse: [left _ width]].
	inner _ outer insetBy: inset.
	^(inner left + left) @ (inner top) corner: (inner right - right) @ (inner bottom)! !

!TeletypeMorph methodsFor: 'character writing'!
fillScreen: char

	self
		clearSelection;
		linesDo: [:line | line atAllPut: char fg: fg bg: bg em: em]! !

!TeletypeMorph methodsFor: 'character writing'!
put: aChar

	scrollOnOutput ifTrue: [self pageEnd].
	(insertMode and: [x < cols]) ifTrue: [(self protectSelection; currentLine) insertAt: x].
	(aChar == 13 & autoLinefeed or: [aChar == 10 & autoCR])
		ifTrue: [self newline]
		ifFalse: [self putNormal: aChar; cursorRight: 1 wrapping: true]! !

!TeletypeMorph methodsFor: 'character writing'!
putNormal: aChar

	x >= cols ifTrue: [self wrapIfPossible].
	selectionActive ifTrue: [self protectSelection].
	self currentLine at: x put: (Character value: aChar) fg: fg bg: bg em: em! !

!TeletypeMorph methodsFor: 'character writing'!
resetVideo

	self
		clearSelection;
		setBackground: 7;
		setForeground: 0;
		setEmphasis: 0! !

!TeletypeMorph methodsFor: 'character writing'!
setBackground: index

	bg _ index min: 7 max: 0.! !

!TeletypeMorph methodsFor: 'character writing'!
setEmphasis: index

	index == 0 ifTrue: [^em _ 0].
	em _ em bitOr: (1 bitShift: index - 1).! !

!TeletypeMorph methodsFor: 'character writing'!
setEmphasis: index to: bit

	bit == 0
		ifTrue: [em _ em bitClear: (1 bitShift: index - 1)]
		ifFalse: [em _ em bitOr: (1 bitShift: index - 1)]! !

!TeletypeMorph methodsFor: 'character writing'!
setForeground: index

	fg _ index min: 7 max: 0! !

!TeletypeMorph methodsFor: 'cursor control'!
activePosition

	^x@y! !

!TeletypeMorph methodsFor: 'cursor control'!
activePosition: aPoint

	self hideCursor.
	x _ aPoint x min: cols max: 1.
	y _ aPoint y min: rows max: 1.
	relativeOrigin ifTrue: [y _ y + topLine - 1 min: bottomLine max: topLine].
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
bs

	self cursorLeft: 1 wrapping: false! !

!TeletypeMorph methodsFor: 'cursor control'!
clearCursor

	lines do: [ :line | line cursorCol: 0]! !

!TeletypeMorph methodsFor: 'cursor control'!
cr

	self hideCursor.
	x _ 1.
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
cursorDown: n scrolling: scrollFlag

	self hideCursor.
	n timesRepeat: [self cursorDownScrolling: scrollFlag].
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
cursorLeft: n wrapping: wrapFlag

	self hideCursor.
	n timesRepeat: [self cursorLeftWrapping: wrapFlag].
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
cursorRight: n wrapping: wrapFlag

	self hideCursor.
	n timesRepeat: [self cursorRightWrapping: wrapFlag].
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
cursorUp: n scrolling: scrollFlag

	self hideCursor.
	n timesRepeat: [self cursorUpScrolling: scrollFlag].
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
hideCursor

	self currentLine cursorCol: 0! !

!TeletypeMorph methodsFor: 'cursor control'!
lf

	autoCR
		ifTrue: [self newline]
		ifFalse: [self cursorDown: 1 scrolling: true]! !

!TeletypeMorph methodsFor: 'cursor control'!
newline

	self hideCursor; cursorDown: 1 scrolling: true.
	x _ 1.
	self showCursor! !

!TeletypeMorph methodsFor: 'cursor control'!
showCursor

	self currentLine cursorCol: x! !

!TeletypeMorph methodsFor: 'operating modes'!
doFullReset
	"Clear the screen, reset tabs to every eight columns, and reset the terminal modes (such as wrap and smooth scroll) to their initial states just after terminal initialisation."

	self
		doSoftReset;
		clearSelection;
		clearScreen;
		activePosition: 1@1;
		initializeTabs;
		initializeTerminalModes;
		changed! !

!TeletypeMorph methodsFor: 'operating modes'!
doResetAndClear
	"Reset the terminal to a sane state and clear the saved lines."

	self doFullReset.
	displayStart _ 0.
	savedLines _ 0.
	lines _ lines copyFrom: lines size - rows + 1 to: lines size.
	self linesChanged; changed! !

!TeletypeMorph methodsFor: 'operating modes'!
doSoftReset
	"Reset scroll regions.  This can be convenient when some program has left the scroll regions set incorrectly (often a problem when using VMS or TOPS-20)."

	topLine _ 1.
	bottomLine _ rows.! !

!TeletypeMorph methodsFor: 'operating modes'!
metaSendsEscape: aBoolean

	metaSendsEscape _ aBoolean! !

!TeletypeMorph methodsFor: 'operating modes'!
setAltScreenColours: aBoolean

	altScreenColours _ aBoolean.
	self setEmacsColours: ec.! !

!TeletypeMorph methodsFor: 'operating modes'!
setAutoLinefeed: aBoolean

	autoLinefeed _ aBoolean! !

!TeletypeMorph methodsFor: 'operating modes'!
setAutoWrap: aBoolean

	autoWrap _ aBoolean! !

!TeletypeMorph methodsFor: 'operating modes'!
setEmacsColours: aBoolean

	(ec _ aBoolean) & altScreenColours
		ifTrue: [submorphs from: 1 to: rows do: [:line | line emacsColours]]
		ifFalse: [submorphs from: 1 to: rows do: [:line | line normalColours]].
	self changed! !

!TeletypeMorph methodsFor: 'operating modes'!
setIconTitle: aString

	systemWindow notNil
		ifTrue:
			[(systemWindow isKindOf: TeletypeWindow)
				ifTrue: [systemWindow setIconTitle: aString]]
				"icon title ignored by other kinds of window"! !

!TeletypeMorph methodsFor: 'operating modes'!
setInsertMode: aBoolean

	insertMode _ aBoolean! !

!TeletypeMorph methodsFor: 'operating modes'!
setRelativeOrigin: aBoolean

	relativeOrigin _ aBoolean.
	self activePosition: 1@1! !

!TeletypeMorph methodsFor: 'operating modes'!
setReverseVideo: aBoolean

	reverseVideo == aBoolean ifTrue: [^self].
	reverseVideo _ aBoolean.
	submorphs from: 1 to: rows do: [ :m | m rv: (rv xor: reverseVideo)].
	self changed! !

!TeletypeMorph methodsFor: 'operating modes'!
setScrollRegionTop: top bottom: bottom

	topLine _ top min: rows - 1 max: 1.
	bottomLine _ bottom min: rows max: top + 1! !

!TeletypeMorph methodsFor: 'operating modes'!
setShowCursor: aBoolean

	self hideCursor.
	showCursor _ aBoolean.
	self showCursor! !

!TeletypeMorph methodsFor: 'operating modes'!
setSmoothScroll: aBoolean

	autoFlush _ 0.
	smoothScroll _ aBoolean! !

!TeletypeMorph methodsFor: 'operating modes'!
setWidth: nCols

	allow132 ifTrue: [self setWidth: nCols height: rows]! !

!TeletypeMorph methodsFor: 'operating modes'!
setWindowTitle: aString

	systemWindow notNil
		ifTrue:
			[(systemWindow isKindOf: TeletypeWindow)
				ifTrue: [systemWindow setWindowTitle: aString]
				ifFalse: [systemWindow setLabel: aString]]! !

!TeletypeMorph methodsFor: 'editor functions'!
clearLine

	self
		hideCursor;
		clearLine: y from: 1 to: cols;
		showCursor! !

!TeletypeMorph methodsFor: 'editor functions'!
clearLine: n from: l to: r

	(self lineAt: n)
		from: l to: r put: $  fg: fg bg: bg em: 0;
		lastColumn: l - 1.! !

!TeletypeMorph methodsFor: 'editor functions'!
clearLineLeft

	self
		clearSelection;
		hideCursor;
		clearLine: y from: 1 to: x;
		showCursor! !

!TeletypeMorph methodsFor: 'editor functions'!
clearLineRight

	self
		clearSelection;
		hideCursor;
		clearLine: y from: x to: cols;
		showCursor! !

!TeletypeMorph methodsFor: 'editor functions'!
clearScreen

	self hideCursor.
	1 to: rows do: [:i | self clearLine: i from: 1 to: cols].
	self showCursor.! !

!TeletypeMorph methodsFor: 'editor functions'!
clearScreenLeft

	self
		clearSelection;
		hideCursor;
		clearLine: y from: 1 to: x.
	1 to: y - 1 do: [:i | self clearLine: i from: 1 to: cols].
	self showCursor.
	self flush! !

!TeletypeMorph methodsFor: 'editor functions'!
clearScreenRight

	self
		clearSelection;
		hideCursor;
		clearLine: y from: x to: cols.
	y + 1 to: rows do: [:i | self clearLine: i from: 1 to: cols].
	self showCursor.
	self flush! !

!TeletypeMorph methodsFor: 'editor functions'!
deleteForward: n

	self hideCursor.
	n timesRepeat: [self deleteForward].
	self showCursor! !

!TeletypeMorph methodsFor: 'editor functions'!
deleteLines: n

	self hideCursor.
	n timesRepeat: [self deleteLine].
	self showCursor.
	self autoFlush! !

!TeletypeMorph methodsFor: 'editor functions'!
insert: n

	self hideCursor.
	n timesRepeat: [self insert].
	self showCursor! !

!TeletypeMorph methodsFor: 'editor functions'!
insertLines: n

	self hideCursor.
	n timesRepeat: [self insertLine].
	self showCursor.
	self autoFlush! !

!TeletypeMorph methodsFor: 'tabs'!
clearTab

	x <= cols ifTrue: [tabs at: x put: false].
"
	Transcript
		nextPutAll: 'tab CLR ', x printString; tab;
		nextPutAll: (String withAll: (tabs collect: [:t | t ifTrue: [$!!] ifFalse: [$.]]));
		cr; endEntry
"! !

!TeletypeMorph methodsFor: 'tabs'!
clearTabs

	tabs atAllPut: false.! !

!TeletypeMorph methodsFor: 'tabs'!
setTab

	x <= cols ifTrue: [tabs at: x put: true].
"
	Transcript
		nextPutAll: 'tab SET ', x printString; tab;
		nextPutAll: (String withAll: (tabs collect: [:t | t ifTrue: [$!!] ifFalse: [$.]]));
		cr; endEntry
"! !

!TeletypeMorph methodsFor: 'tabs'!
tab

	self hideCursor.
	[x _ x + 1.
	 x < cols and: [(tabs at: x) not]]
		whileTrue.
	x _ x min: cols.
	self showCursor.! !

!TeletypeMorph methodsFor: 'protocol'!
down: protoLo

	down _ protoLo! !

!TeletypeMorph methodsFor: 'protocol'!
flush

	submorphs from: 1 to: rows do: [ :m | m flush].
	autoFlush _ self autoFlushCount.
	self updateScrollbar.! !

!TeletypeMorph methodsFor: 'protocol'!
install

	session isNil ifFalse: [session propertyAt: #window put: self]! !

!TeletypeMorph methodsFor: 'protocol'!
isConnected

	^session notNil and: [session isConnected]! !

!TeletypeMorph methodsFor: 'protocol'!
note: aSymbol with: anObject

	aSymbol == #endpointClosed
		ifTrue:
			[^(systemWindow isKindOf: TeletypeWindow)
				ifTrue: [systemWindow endpointClosed]].

	aSymbol == #savePreferences ifTrue: [^self