{ import: Utility } { import: Views } { import: Views-drawing } { import: Views-properties } { import: Views-events } { import: Views-scrolling } { import: Views-layout } { import: Views-world } { import: Colour } { import: Shape } { import: Event } { import: EventHandler } { import: _vtable } { import: Signal } { import: TextBuffer } { import: SDLWindow } "----------------------------------------------------------------" "Range represents a range between two integers (or two comarable object maybe). It is almost same as Ingerval in Smalltalk except step." Range : SequenceableCollection (first last) Range from: firstValue to: lastValue [ self := self new. first := firstValue. last := lastValue. ] Range at: offset [ ^first + offset ] Range first [ ^first ] Range last [ ^last ] Range size [ ^last - first ] Range copy [ ^Range from: first to: last ] Range + aNumber [ ^ first + aNumber to: last + aNumber ] Number to: aNumber [ ^ Range from: self to: aNumber ] Number size: aNumber [ ^ Range from: self to: self + aNumber ] Range sorted [ ^ first < last ifTrue: [ self ] ifFalse: [ last to: first ] ] Range union: aRange [ "Answer the smallest Range that contains both the receiver and aRange." ^self from: (first min: aRange first) to: (last max: aRange last) ] Range printOn: aStream [ first printOn: aStream. aStream nextPutAll: ' to: '. last printOn: aStream. ] Range do: aBlock [ first to: last do: aBlock ] "about to merge to SequenceableCollection >> findBinary:ifNone:" Range largestSatisfied: aBlock [ "Search for the largest element which satisfies the condition" | index low high test item | self size = 0 ifTrue: [ ^ first ]. (aBlock value: first) ifFalse: [ ^ first ]. low := 0. high := self size. [index := high + low // 2. low > high] whileFalse:[ test := aBlock value: (item := self at: index). test ifTrue:[low := index + 1] ifFalse:[high := index - 1]]. ^ self at: high ] "----------------------------------------------------------------" "TextView (a View for Text)" TextView : ShapedView ( text "TextBuffer object" lines "A list of Range which represents a physical line" selection "Selection range from mark to point. 0 to: 0 if there is no text." clipboard fontSize "Size of the font" default "Default object for demo only [class variable]" fileName "File name of the current document" isSelecting "True if it is selecting" history "A list of TextBufferChange" historyIndex ) TextView text [ ^text ] TextView selection [ ^selection ] TextView selection: aRange [ selection := aRange ] TextView fontSize [ ^fontSize ] TextView fontSize: aNumber [ fontSize := aNumber. self recompose. ] TextView contents [ ^text contents ] TextView contents: aString [ text contents: aString. self moveBeginning ] TextView default [ ^default ] TextView default: anObject [ default := anObject ] TextView caret [ ^selection last ] TextView fileName [ ^fileName ] TextView fileName: aString [ fileName := aString ] TextView isSelecting: aBoolean [ isSelecting := aBoolean ] TextView lines [ ^lines ] "only for debugging purpose" Joe : Object () "just for demo" "Entry Point of the application (class method)" TextView main [ | extent editor world isRunning pane v1 scrollWithBar window | extent := 640, 480. editor := self new. window := SDLWindow new. window extent: extent. v1 := (0, 0 extent: 60, 60) shapedView. v1 fillColour: (Colour withR: 0.8 G: 0.4 B: 0.4). v1 := v1 transformView. v1 translateBy: 200, 20. v1 propertyAt: #pointerDownEvent put: [:v :event | event handler beginDragging: v from: event]. Joe := v1. pane := (0, 0 extent: extent x - 10, extent y) scrollingView. pane fillColour: (Colour withR: 0.9 G: 0.9 B: 1.0). pane add: v1. pane add: editor. editor when: #onCaretChanged do: pane >>> #scrollTo:. scrollWithBar := pane withVerticalScrollBar. world := WorldView withShape: (0, 0 extent: extent). world surface: window. world fillColour: (Colour withR: 0.8 G: 0.8 B: 0.8). world add: scrollWithBar. editor initWorkspace. "Hijack keyDownEvent. Fix it later as a FocusedEventHandler" world propertyAt: #keyDownEvent put: [:v :event | editor _keyDownEvent :event ]. world propertyAt: #quitEvent put: [:v :event | isRunning := false ]. world propertyAt: #resizeEvent put: [:v :event | | ex bar | ex := event position. event window extent: event position. world shape: (0, 0 extent: ex). pane shape: (0, 0 extent: ex x - 10, ex y). editor shape: (0, 0 extent: ex x - 10, editor shape height). editor recompose. bar := scrollWithBar contents first nextLink. bar translation: pane bounds bottomRight. bar first shape: (0, 0 extent: 10, ex y). world damaged. ]. world drawOn: window painter in: world bounds. isRunning := true. WorldView := world. [isRunning] whileTrue: [ world mainLoop ]. " world mainLoop." window quit. ] TextView new [ self := super new. self initialize. fontSize := 14. ] TextView initialize [ " text := TextArrayBuffer new." text := TextLineBuffer new. lines := OrderedCollection with: (0 to: 0). history := OrderedCollection new. text when: #onReplaced do: self >>> #onReplaced:. selection := 0 to: 0. clipboard := ''. isSelecting := false. self resize: (640 - 10), 480. self fillColour: Colour white. ] TextView onReplaced: aTextBufferChange [ history add: aTextBufferChange. self compose: aTextBufferChange. ] TextView recompose [ | aString | aString := text contents. self compose: (TextBufferChange start: 0 before: aString after: aString). ] TextView compose: aTextBufferChange [ | startLine start end endLogicalPos newLines restLines restLine midLines | surface ifNil: [ ^self ]. self setFont. startLine := (self getPosition: aTextBufferChange start) y. endLogicalPos := text getPosition: aTextBufferChange afterEnd. end := (text getOffset: -1, endLogicalPos y) + 1. "Beginning of the next line" restLine := end > text size ifTrue: [ lines size ] "Last line is not \n" ifFalse: [ (self getPosition: end - aTextBufferChange delta) y ]. restLines := (lines copyFrom: restLine) collect: [ :range | range + aTextBufferChange delta]. end := end min: text size. start := (lines at: startLine) first. midLines := (self composeLines: (text from: start size: end - start) width: (self bounds width - 30)) collect: [:range | range + start]. newLines := lines copyFrom: 0 size: startLine. newLines addAll: midLines. newLines addAll: restLines. (restLines isEmpty and: [text size = 0 or: [(text at: text size - 1) = $\n]]) ifTrue: [newLines add: (text size to: text size)]. lines := newLines. self noteDamaged: startLine beforeHight: restLine - startLine afterHight: midLines size. self extentChanged. ] TextView noteDamaged: top beforeHight: beforeHight afterHight: afterHight [ | damageBounds | damageBounds := beforeHight = afterHight ifTrue: [0, (self baseLineFor: top + beforeHight) corner: self bounds right, (self baseLineFor: top - 1)] ifFalse: [0, 0 corner: self bounds right, (self baseLineFor: top - 1)]. self damaged: damageBounds. ] TextView composeLines: aString width: width [ | newLines strings offset i range | newLines := OrderedCollection new. strings := aString split: $\n. offset := 0. strings do: [ :each | i := 0. [ range := self composeLine: each from: i width: width. range size = 0 ifFalse: [newLines add: range + offset]. "Fix it later" i := range last. range last < each size ] whileTrue. offset := offset + each size. ]. ^ newLines ] TextView composeLine: aString from: start width: width [ | foundSize | foundSize := (0 size: aString size - start) largestSatisfied: [ :size | (surface painter textExtents: (aString copyFrom: start size: size)) x_advance <= width]. ^ start to: start + foundSize. ] TextView setFont [ surface painter setFontSize: fontSize. surface painter selectFontFace: 'Courier New'. ] TextView drawOn: aCanvas in: clipRectangle [ super drawOn: aCanvas in: clipRectangle. aCanvas setFontSize: fontSize. self drawTextOn: aCanvas in: clipRectangle. self drawSelectionOn: aCanvas in:clipRectangle. self drawCaretOn: aCanvas in: clipRectangle. ] TextView baseLineFor: rows [ ^ self bounds height - (rows + 1 * fontSize) ] TextView drawTextOn: aCanvas in: clipRectangle [ | drawCondition line | aCanvas setSource: Colour black. lines doWithIndex: [ :range :rows | drawCondition := self drawCondition: clipRectangle rows: rows. drawCondition = #headSkip ifTrue: [ "skip" ]. drawCondition = #tailSkip ifTrue: [ ^self ]. drawCondition = #draw ifTrue: [ aCanvas moveTo: (10, (self baseLineFor: rows)). line := (text from: range first size: range size). (line size > 0 and: [(line at: line size - 1) = $\n]) ifTrue: [line at: line size - 1 put: 0]. aCanvas showText: line]. ]. ] TextView drawCondition: clipRectangle rows: rows [ clipRectangle top < (self baseLineFor: rows) ifTrue: [^#headSkip]. clipRectangle bottom > (self baseLineFor: rows - 1) ifTrue: [^#tailSkip]. ^ #draw. ] TextView extentChanged [ | rows | rows := (self getPosition: text size) y. self resize: self bounds width, (rows + 1 * fontSize). ] TextView drawCaretOn: aCanvas in:clipRectangle [ | p | p := self getPosition: self caret on: aCanvas. aCanvas setSource: (Colour withR: 0 G: 0.5 B: 0.5). aCanvas rectangle: (p x, p y extent: 2, fontSize). aCanvas fill. ] TextView drawSelectionOn: aCanvas in:clipRectangle [ | textExtent begin selectedLines rest y line | selection first = selection last ifTrue: [ ^self ]. "Unselected" aCanvas setSourceR: 0 G: 0.5 B: 0 A: 0.3. "1st: Collect all ranges of the selection" selectedLines := OrderedCollection new. rest := selection sorted. y := (self getPosition: rest first) y. [ line := lines at: y. rest last > line last] whileTrue: [ selectedLines add: (rest first to: line last). rest := line last to: rest last. y := y + 1]. selectedLines add: (rest first to: rest last). "2nd: Fill all ranges" selectedLines doWithIndex: [ :range :index | begin := self getPosition: range first on: aCanvas. textExtent := aCanvas textExtents: (text from: range first size: range size). aCanvas rectangle: (begin extent: textExtent x_advance, fontSize). aCanvas fill. ]. ] TextView indexAtPoint: aPair on: aCanvas [ | line beforeString width | lines doWithIndex: [:range :rows | (self baseLineFor: rows) < aPair y ifTrue: [ line := text from: range first size: range size. line doWithIndex: [ :char :cols | beforeString := line copyFrom: 0 size: cols. width := (aCanvas textExtents: beforeString) x_advance. width > (aPair x - 10) ifTrue: [ ^range first + cols ]]. ^range first + line size - 1]]. ^ text size. ] TextView cols [ ^(self getPosition: self caret) x ] TextView getPosition: index [ "Convert from cursor position to physical coordinate in (cols, rows)" lines isEmpty ifTrue: [ ^0, 0 ]. lines doWithIndex: [:range :rows | (range first <= index and: [index < range last]) ifTrue: [ ^ index - range first, rows ]]. ^ lines last size, (lines size - 1) ] TextView getPosition: index on: aCanvas [ "Convert from cursor position to physical coordinate in pixel" | p beforeString width | p := self getPosition: index. beforeString := text from: index - p x size: p x. width := (aCanvas textExtents: beforeString) x_advance. ^ (10 + width), (self baseLineFor: p y). ] TextView getOffset: position [ "Convert from physical coordinate in (cols, rows) to offset. (-1, y) means last line, and (x, -1) means end of the line. If the value is larger than size, maximum size is chosen." | range x y eof | lines isEmpty ifTrue: [ ^0 ]. y := ((position y = -1) or: [ position y >= lines size ]) ifTrue: [lines size - 1] ifFalse: [position y]. range := lines at: y. eof := y = (lines size - 1) ifTrue: [ range size ] ifFalse: [ range size - 1 ]. x := ((position x = -1) or: [ position x > eof ]) ifTrue: [eof] ifFalse: [position x]. ^ range first + x ] TextView replaceFrom: start size: size with: aString [ text replaceFrom: start size: size with: aString. historyIndex := nil. ] TextView append: aString [ | newCaret | self deleteSelection. newCaret := self caret + aString size. self replaceFrom: self caret size: 0 with: aString. selection := newCaret to: newCaret. ] TextView keyboardQuit [ isSelecting := false. self clearSelection. ] TextView xInsert: anInteger [ self append: (String with: anInteger) ] TextView xBackspace: aChar [ | index | self deleteSelection ifTrue: [ ^self ]. self pointsBegginingOfFile ifTrue: [ ^self ]. index := selection last. self replaceFrom: index - 1 size: 1 with: ''. selection := index - 1 size: 0. ] TextView deleteSelection [ selection size = 0 ifTrue: [ ^false ]. self replaceFrom: selection sorted first size: selection size with: ''. selection := selection sorted first size: 0. ^ true. ] TextView pointsEndOfFile [^ selection last = text size] TextView pointsBegginingOfFile [^ selection last = 0] TextView point: offset event: event [ selection := (isSelecting or: [event notNil and: [event shiftPressed]]) ifTrue: [ selection first to: offset ] ifFalse: [ offset to: offset ] ] TextView xLeft: event [ self pointsBegginingOfFile ifTrue: [ ^self ]. self point: self caret - 1 event: event. ] TextView xRight: event [ self pointsEndOfFile ifTrue: [ ^self ]. self point: self caret + 1 event: event. ] TextView xBOL: event [ | p offset | p := self getPosition: self caret. offset := self getOffset: 0, p y. self point: offset event: event. ] TextView xEOL: event [ | p offset | p := self getPosition: self caret. offset := self getOffset: -1, p y. self point: offset event: event. ] TextView moveBeginning [ selection := 0 to: 0 ] TextView xUp: event [ | p offset | p := self getPosition: self caret. offset := self getOffset: p x, (0 max: p y - 1). self point: offset event: event. ] TextView xDown: event [ | p offset | p := self getPosition: self caret. offset := self getOffset: p x, (p y + 1). self point: offset event: event. ] TextView selectionContents [ ^ text from: selection sorted first size: selection size ] TextView clearSelection [ selection := selection last to: selection last. isSelecting := false. self damaged. ] TextView load: aString [ | file | self fileName: aString. SDL setCaption: aString icon: 'bottle'. file := File openIfPresent: aString. file isNil ifTrue: [^ self contents: '' ]. self contents: file readStream contents. file close. self extentChanged. history := OrderedCollection new. historyIndex := nil. ] File printOn: aStream [ aStream nextPutAll: 'File (', _fd printString, ', ', name printString, ')'. ] TextView save [ self saveAs: self fileName ] TextView copy [ clipboard := self selectionContents. self clearSelection ] TextView cut [ clipboard := self selectionContents. self deleteSelection. self clearSelection ] TextView paste [ self append: clipboard. self clearSelection ] TextView killLine [ | line | line := text lineFrom: self caret. clipboard := line. self replaceFrom: self caret size: line size with: (line = '\n' ifTrue: [ '' ] ifFalse: [ '\n' ]). self clearSelection. ] TextView saveAs: aString [ "TODO: rewrite with stream" text contents writeToFileNamed: aString. ] TextView undo [ | undoCommand newCaret | historyIndex ifNil: [ historyIndex := history size - 1 ]. historyIndex < 0 ifTrue: [ ^ self ]. undoCommand := (history at: historyIndex) inverse. text replace: undoCommand. historyIndex := historyIndex - 1. newCaret := undoCommand start + undoCommand after size. selection := newCaret to: newCaret. ] { import: Shell } TextView initWorkspace [ "1: 'boot.k' is executed. 2: If it is available, 'bottle.k' is executed. 3: If it is unavailable, first argument is read in the buffer (safe mode)." | boot file | TextView default: self. Options libdir: self baseDirectory, 'lib'. (self evalFile: 'boot.k') ifNotNil: [ (self evalFile: 'bottle.k') ifNotNil: [ ^self ]]. OS arguments isEmpty ifFalse: [ self load: OS arguments first ]. ] TextView baseDirectory [ ^(OS argumentAt: 0) directoryName ] TextView evalFile: scriptName [ | file | file := (File openIfPresent: scriptName) ifFalse: [File openIfPresent: Options libdir, '/', scriptName]. file isNil ifTrue: [ ^ nil ]. Shell eval: file readStream to: SinkStream. file close. ] TextView xDoit: event [ | input resultStream result | input := self selectionContents. resultStream := WriteStream on: (String new: 8). self eval: input to: resultStream. result := resultStream contents. self clearSelection. isSelecting := false. ^ result. ] TextView xPrintIt: event [ | result | result := self xDoit: event. self append: result. selection := self caret - result size to: self caret. ] TextView eval: aString to: resultStream [ Shell eval: aString readStream to: resultStream. ] TextView resize: aPair [ self shape: (0, 0 extent: aPair). ] TextView handleEdit: aBlock [ | before after caretBounds damageBounds range top bottom | before := self selection copy. aBlock value. after := self getPosition: self caret. caretBounds := 10, (self baseLineFor: after y) extent: 2, fontSize. self triggerSignal: #onCaretChanged with: caretBounds. range := before sorted union: self selection sorted. top := (self getPosition: range first) y. bottom := (self getPosition: range last) y. self damaged: (0, (self baseLineFor: bottom) corner: self bounds right, (self baseLineFor: top - 1)) ] TextView _keyDownEvent :anEvent [ self handleEdit: [ self handleKeyDownEvent: anEvent ]. ] TextView handleKeyDownEvent: anEvent [ " ('ucs: ', anEvent ucs4 printString) putln. anEvent key printString putln." (anEvent altPressed and: [anEvent ucs4 = $p]) ifTrue: [^ self xDoit: anEvent]. (anEvent altPressed and: [anEvent ucs4 = $s]) ifTrue: [^ self save]. anEvent key = SDL SDLK_BACKSPACE ifTrue: [^ self xBackspace: anEvent]. anEvent key = SDL SDLK_UP ifTrue: [^ self xUp: anEvent]. anEvent key = SDL SDLK_DOWN ifTrue: [^ self xDown: anEvent]. anEvent key = SDL SDLK_RIGHT ifTrue: [^ self xRight: anEvent]. anEvent key = SDL SDLK_LEFT ifTrue: [^ self xLeft: anEvent]. anEvent ucs4 <= 0 ifTrue: [^anEvent]. anEvent ucs4 = $\r ifTrue: [^ self xInsert: $\n]. anEvent ucs4 < 256 ifTrue: [^ self xInsert: anEvent ucs4]. ] TextView pointerDownEvent :event [ self handleEdit: [ | offset | self setFont. offset := self indexAtPoint: event localPosition on: event window painter. isSelecting := false. self point: offset event: nil. isSelecting := true. ]. ] TextView pointerMotionEvent :event [ isSelecting ifTrue: [ self handleEdit: [ | offset | self setFont. offset := self indexAtPoint: event localPosition on: event window painter. self point: offset event: nil]]. ] TextView pointerUpEvent :event [ isSelecting := false. ] [ TextView := TextView new ] "---------- Event Handler ----------" EventHandler quitEvent :anEvent [ ^world handleWorldEvent: anEvent ] EventHandler resizeEvent :anEvent [ ^world handleWorldEvent: anEvent ] "---------- Utility Libraries ----------" ComposableView dumpOn: aStream indent: indent [ 0 to: indent do: [:i | aStream tab]. self printOn: aStream. aStream cr. contents do: [:each | each dumpOn: aStream indent: indent + 1]. ] ComposableView dump [ self dumpOn: StdErr indent: 0 ] String directoryName "Answer directory name. It ends with always /" [ | c reader writer elements | reader := self readStream. writer := WriteStream on: (String new: 8). elements := OrderedCollection new. [reader atEnd] whileFalse: [ c := reader next. ('\\/' includes: c) ifTrue: [elements addLast: writer contents. writer reset] ifFalse: [writer nextPut: c]]. writer reset. elements isEmpty ifTrue: [^ './'] ifFalse: [elements do: [:each | writer nextPutAll: each. writer nextPut: $/]]. ^ writer contents ] ReadStream upTo: element [ | writeStream next | writeStream := WriteStream on: (String new: 8). [self atEnd] whileFalse: [ next := self next. writeStream nextPut: next. next == element ifTrue: [^ writeStream contents ]]. ^ writeStream contents. ] String writeToFileNamed: path ifError: errorBlock [ "Write the contents of the receiver into the file named by path. If the file cannot be writter, answer the value of errorBlock." | cPath | cPath := path _stringValue. {{ char *path= (char *)v_cPath; int fd= open(path, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0666); if (fd >= 0) { int position= 0; int remaining= (int)self->v_size >> 1; while (remaining) { int count= write(fd, (char *)self->v__bytes + position, remaining); if (count < 1) break; position += count; remaining -= count; } close(fd); if (!remaining) return v_self; } }}. ^errorBlock value ] String writeToFileNamed: path [ ^self writeToFileNamed: path ifError: [self error: path, ': Error.']. ] "----------------------------------------------------------------" TextViewTest : TestCase () TextViewTest testSingleLine [ | editor | editor := TextView new. editor surface: NullWindow new. self assert: editor cols equals: 0. editor contents: 'Hello World'. self assert: editor contents equals: 'Hello World'. self assert: editor cols equals: 0. editor xRight: nil. self assert: editor cols equals: 1. editor xBOL: nil. self assert: editor cols equals: 0. ] TextViewTest testMultiLine [ | editor | editor := TextView new. editor surface: NullWindow new. editor contents: 'Hello World\n'. editor xUp: nil. self assert: editor cols equals: 0. editor xDown: nil. self assert: editor caret equals: 12. editor append: 'Bye World'. self assert: editor contents equals: 'Hello World\nBye World'. editor xUp: nil. self assert: editor cols equals: 9. editor xEOL: nil. self assert: editor cols equals: 11. editor xEOL: nil. self assert: editor cols equals: 11. editor xDown: nil. self assert: editor cols equals: 9. ] TextViewTest testSelection [ | editor | editor := TextView new. self log: '# Insert test'. editor contents: 'Line2\n'. editor append: 'Line1\n'. self assert: editor contents equals: 'Line1\nLine2\n'. self log: '# Backspace test'. editor xBackspace: nil. self assert: editor contents equals: 'Line1Line2\n'. self log: '# Selection test'. editor contents: 'Hello World'. editor xRight: self shiftEvent. " self assert: editor selectionContents equals: 'H'. editor selection: (editor caret + 4 to: editor caret). self assert: editor selectionContents equals: 'ello'. editor contents: '\nHello World\n\n'. editor xDown: self shiftEvent. editor xDown: self shiftEvent. self assert: editor selectionContents equals: '\nHello World\n'. editor clearSelection. editor xUp: self shiftEvent. editor xUp: self shiftEvent. self assert: editor selectionContents equals: '\nHello World\n'. "] TextViewTest testPosition [ | editor | editor := TextView new. editor surface: NullWindow new. editor contents: 'Hello\nWorld\nHackers\n'. self assert: (editor text getPosition: editor caret) equals: 0, 0. editor xRight: nil. editor xDown: nil. self assert: (editor text getPosition: editor caret) equals: (Pair x: 1 y: 1). editor xLeft: nil. self assert: (editor text getPosition: editor caret) equals: (Pair x: 0 y: 1). editor xLeft: nil. self assert: (editor text getPosition: editor caret) equals: (Pair x: 5 y: 0). editor xRight: nil. editor xDown: nil. editor xDown: nil. self assert: (editor text getPosition: editor caret) equals: (Pair x: 0 y: 3). ] TextViewTest testFile [ | editor | editor := TextView new. editor contents: 'Hello World\n'. editor saveAs: 'test.txt'. editor contents: ''. editor load: 'test.txt'. self assert: editor contents equals: 'Hello World\n'. ] TextViewTest testEval [ | editor | editor := TextView new. editor initWorkspace. editor contents: 'Good night World\n'. editor eval: '[[TextView default] saveAs: \'"test.txt"]' to: SinkStream new. editor contents: ''. editor eval: '[[TextView default] load: \'"test.txt"]' to: SinkStream new. self assert: editor contents equals: 'Good night World\n'. ] TextViewTest testRange [ | result | self assert: (5 to: 10) size equals: 5. self assert: (10 to: 5) size equals: -5. result := OrderedCollection new. (5 to: 10) do: [:i | result add: i]. self assert: result asArray equals: #(5 6 7 8 9 10). result := OrderedCollection new. (10 to: 5) do: [:i | result add: i]. self assert: result asArray equals: #(). result := OrderedCollection new. (5 to: 5) do: [:i | result add: i]. self assert: result asArray equals: #(5). ] TextViewTest testLargestSatisfied [ | result | result := (1 to: 3) largestSatisfied: [ :e | e < 2 ]. self assert: result equals: 1. result := (1 to: 3) largestSatisfied: [ :e | e <= 2 ]. self assert: result equals: 2. result := (10 to: 30) largestSatisfied: [ :e | e < 100 ]. self assert: result equals: 30. result := (10 to: 30) largestSatisfied: [ :e | e < 0 ]. self assert: result equals: 10. result := (10 to: 30) largestSatisfied: [ :e | e < 20 ]. self assert: result equals: 19. result := (10 to: 30) largestSatisfied: [ :e | e < 30 ]. self assert: result equals: 29. result := (10 to: 100) largestSatisfied: [ :e | e < 11 ]. self assert: result equals: 10. ] TextViewTest testDirectoryName [ self assert: 'C:\\takashi\\secret\\file.txt' directoryName equals: 'C:/takashi/secret/'. self assert: 'C:\\file.txt' directoryName equals: 'C:/'. self assert: 'file.txt' directoryName equals: './'. self assert: '/usr/local/secret/file.txt' directoryName equals: '/usr/local/secret/'. self assert: '/usr/file.txt' directoryName equals: '/usr/'. self assert: '/file.txt' directoryName equals: '/'. ] TextViewTest _testScroll [ | editor | editor := TextView new. self assert: (editor getOffsetFor: 10 offset: 0 height: 100 fontSize: 10) equals: 0. "it doesn't move" self assert: (editor getOffsetFor: 110 offset: 0 height: 100 fontSize: 10) equals: 10. "scroll down" self assert: (editor getOffsetFor: 10 offset: 10 height: 100 fontSize: 10) equals: 0. "scroll up" ] TextViewTest testCanvas [ | editor | editor := TextView new. editor surface: NullWindow new. editor contents: 'Hello World!\nBye World!\n'. editor resize: 630, 480. "It makes calculation easier." self assert: (editor indexAtPoint: 10 + 7, (480 - 1) on: NullCanvas) equals: 1. self assert: (editor indexAtPoint: 10 + 7, (480 - (18 + 1)) on: NullCanvas) equals: 14. self assert: (editor indexAtPoint: 999, (480 - 1) on: NullCanvas) equals: 12. "Far right" self assert: (editor indexAtPoint: 999, 999 on: NullCanvas) equals: 12. "Far top" self assert: (editor indexAtPoint: 10 + 7, 0 on: NullCanvas) equals: 24. "Far bottom" self assert: (editor getPosition: 0 on: NullCanvas) equals: 10, (480 - editor fontSize). self assert: (editor getPosition: 13 on: NullCanvas) equals: 10, (480 - (editor fontSize * 2)). ] TextViewTest testCompose [ | editor text | editor := TextView new. editor surface: NullWindow new. self assert: editor lines first equals: (0 to: 0). editor append: 'Hello World!\n'. self assert: editor lines first equals: (0 to: 13). editor append: 'Bye World!\n'. self assert: editor lines second equals: (13 to: 24). self assert: editor lines third equals: (24 to: 24). editor selection: (0 to: 0). editor append: 'OK.'. self assert: editor contents equals: 'OK.Hello World!\nBye World!\n'. self assert: editor lines first equals: (0 to: 16). self assert: editor lines second equals: (16 to: 27). editor contents: ''. self assert: editor lines first equals: (0 to: 0). ] TextViewTest testComposeNewline [ | editor text lines | text := 'Hello World!\nBye World!\n'. editor := TextView new. editor surface: NullWindow new. lines := editor composeLines: text width: 500. self assert: lines first equals: (0 to: 13). self assert: lines second equals: (13 to: 24). ] TextViewTest testComposeWidth [ | editor text lines | editor := TextView new. editor surface: NullWindow new. self assert: editor lines first equals: (0 to: 0). lines := editor composeLines: 'hello' width: 80. self assert: lines first equals: (0 to: 5). lines := editor composeLines: '0123456789012' width: 80. self assert: lines first equals: (0 to: 10). self assert: lines second equals: (10 to: 13). ] TextViewTest testWindow [ | parent child | parent := View new. child := View new. parent surface: 1. parent add: child. self assert: child surface equals: 1. parent := View new. child := View new. parent add: child. parent surface: 1. self assert: child surface equals: 1. ] Object shiftEvent [ ^KeyDownEvent new setShiftPressed; yourself ]