{ import: Box }
{ import: SDLSurface }
{ import: Signal }
{ import: Range }

Adjustment : Object (inner outer)
"Adjustment represents an adjustable bounded value"

Adjustment new
[
    self := super new.
    self inner: (0 to: 0) outer: (0 to: 1).
]

Adjustment inner	[ ^inner ]
Adjustment outer	[ ^outer ]
Adjustment margin	[ ^outer size - inner size ]
Adjustment pageSize	[ ^inner size ]
Adjustment outerSize	[ ^outer size ]
Adjustment value	[ ^inner first ]
Adjustment value: aNumber [ self inner: (aNumber size: inner size) outer: outer ]

"Normalize from 0 to 1.0"
Adjustment rate		[ ^self margin = 0 ifTrue: [0] ifFalse: [inner first - outer first / self margin ]]
Adjustment rate: value	[ self value: value * self margin + outer first ]

Adjustment pageSize: pageSize outerSize: outerSize
[
    self inner: (inner first size: pageSize) outer: (outer first size: outerSize)
]

Adjustment inner: innerRange outer: outerRange
[
    inner := innerRange size > outerRange size
"	ifTrue: [ outerRange size - innerRange size // 2 size: innerRange size ]"
	ifTrue: [ 0 size: innerRange size ]
	ifFalse: [ innerRange first < outerRange first
	    ifTrue: [ outerRange first size: innerRange size ]
	    ifFalse: [ outerRange last < innerRange last
	        ifTrue: [ outerRange last - innerRange size size: innerRange size ]
	        ifFalse: [ innerRange ]]].

    outer := outerRange.
    self triggerSignal: #changed with: self.
]

Adjustment printOn: aStream
[
    aStream nextPutAll: '(Adjustment inner: '.
    inner printOn: aStream.
    aStream nextPutAll: ' outer: '.
    outer printOn: aStream.
    aStream nextPutAll: ')'.
]

"----------------------------------------------------------------"

ScrollHandler : DraggingHandler ()

ScrollHandler buttonDown :anEvent
[
    anEvent hand addEventHandler: self.
    reference := anEvent position - box slider position.
]

ScrollHandler motion :anEvent
[
    box scrollAbsolute: anEvent position - reference
]

"----------------------------------------------------------------"

ScrollBarPitch := [ 16 ]

ScrollBar : Box (slider model)
  VScrollBar : ScrollBar ()
  HScrollBar : ScrollBar ()

ScrollBar new
[
    self := super new.
    self border: ColorGray50.
    self background: ColorGray75.
    self buttonDown: self >>> #scrollPage:.
    slider := Box new.
    slider border: ColorGray50.
    slider buttonDown: (ScrollHandler with: self).
    slider background: ColorWhite.
    self add: slider.
    model := Adjustment new.
    model when: #changed do: self >>> #modelChanged:.
]

ScrollBar slider	[ ^slider ]
ScrollBar model		[ ^model ]
ScrollBar margin	[ ^self length - self sliderSize ]

ScrollBar extent: aPoint
[
    super extent: aPoint.
    self modelChanged: nil.
]

ScrollBar scrollPage: anEvent
[
    model value: ((self pageDirection: anEvent) < 0
	ifTrue:  [model value - model pageSize]
	ifFalse: [model value + model pageSize])
]

ScrollBar sliderSize
[
    ^ model pageSize / model outer size * self length max: ScrollBarPitch
]

VScrollBar length [ ^self height ]

VScrollBar pageDirection: anEvent [ ^anEvent position y - slider globalPosition y ]
VScrollBar scrollAbsolute: pos [ model rate: (self margin = 0 ifTrue: [ 0 ] ifFalse: [ pos y / self margin ])]

VScrollBar modelChanged: anObject
[
    slider damaged.
    slider extent: self width, self sliderSize.
    slider position: 0,	(model rate * self margin).
    slider damaged.
]

HScrollBar length [ ^self width ]

HScrollBar pageDirection: anEvent [ ^anEvent position x - slider globalPosition x ]
HScrollBar scrollAbsolute: pos [ model rate: (self margin = 0 ifTrue: [ 0 ] ifFalse: [ pos x / self margin ])]

HScrollBar modelChanged: anObject
[
    slider damaged.
    slider extent: self sliderSize, self height.
    slider position: (model rate * self margin), 0.
    slider damaged.
]

"----------------------------------------------------------------"

"ScorllPane is a container which add scrollbars to the child. It
accepts only one child and when you try to add second, first one is
removed.

You can choose how scrollbars are shown with hscrollBarPolicy and
vscrollBarPol. The options are #automatic or #never."

ScrollPane : Box (hscrollBar vscrollBar scroller hscrollBarPolicy vscrollBarPolicy)

ScrollPane content [ ^ scroller front ]

ScrollPane new
[
    self := super new.
    hscrollBar := HScrollBar new.
    vscrollBar := VScrollBar new.
    hscrollBarPolicy := #automatic.
    vscrollBarPolicy := #automatic.
    scroller := Box new.
    self contents addBack: hscrollBar.
    self contents addBack: vscrollBar.
    self contents addBack: scroller.
    self extent: 400, 300.
    self border: ColorGray50.
    hscrollBar model when: #changed do: self >>> #scrollbarChanged:.
    vscrollBar model when: #changed do: self >>> #scrollbarChanged:.
    scroller clip: true.
]

ScrollPane hscrollBar [ ^hscrollBar ]
ScrollPane vscrollBar [ ^vscrollBar ]
ScrollPane hscrollBarPolicy [ ^hscrollBarPolicy ]
ScrollPane vscrollBarPolicy [ ^vscrollBarPolicy ]
ScrollPane hscrollBarPolicy: aSymbol [ hscrollBarPolicy := aSymbol ]
ScrollPane vscrollBarPolicy: aSymbol [ vscrollBarPolicy := aSymbol ]

ScrollPane add: aBox
[
    scroller contents notEmpty ifTrue: [ scroller contents first removeFromList ].
    scroller add: aBox.
    aBox position: 0, 0.
    self layoutContents.
]

"Scroll so that position of the content moves to the point (typically a negative point)."

ScrollPane scroll: aPoint
[
    hscrollBar model value: aPoint x negated.
    vscrollBar model value: aPoint y negated.
]

ScrollPane scrollbarChanged: anObject
[
    self content ifNil: [ ^self ].
    self content position: hscrollBar model value negated, vscrollBar model value negated.
    self updateScrollPolicy.
    self damaged.
]

ScrollPane extent: aPoint
[
    self layoutExtent: aPoint.
    self updateScrollPolicy.
    scroller extent: aPoint - 
	((hscrollBar hidden and: [vscrollBar hidden])
	    ifTrue: [ PointZero ]
	    ifFalse: [ hscrollBar hidden
	        ifTrue: [ ScrollBarPitch, 0 ]
		ifFalse: [ vscrollBar hidden
		    ifTrue: [ 0, ScrollBarPitch ]
		    ifFalse: [ ScrollBarPitch, ScrollBarPitch ]]]).

    hscrollBar extent: scroller width, ScrollBarPitch.
    vscrollBar extent: ScrollBarPitch, scroller height.

    self content ifTrue: [
	self hscrollBarPolicy = #never ifTrue: [ self content width: scroller width ].
	self vscrollBarPolicy = #never ifTrue: [ self content height: scroller height ].
	hscrollBar model pageSize: scroller width outerSize: self content width.
	vscrollBar model pageSize: scroller height outerSize: self content height].
]

ScrollPane updateScrollPolicy
[
    hscrollBar hidden: (self hscrollBarPolicy = #never or: [hscrollBar model inner size >= hscrollBar model outer size]).
    vscrollBar hidden: (self vscrollBarPolicy = #never or: [vscrollBar model inner size >= vscrollBar model outer size]).
    hscrollBar position: 0, (self height - ScrollBarPitch).
    vscrollBar position: (self width - ScrollBarPitch), 0.
]