{ import: Color }
{ import: Geometry }
{ import: Surface }

BoxList : LinkedList ( myBox )

BoxList forBox: aBox
[
    self := self new.
    myBox := aBox.
]

BoxList addFront: aBox			[ ^super addFirst: (aBox onList: self) ]
BoxList addBack: aBox			[ ^super addLast:  (aBox onList: self) ]
BoxList add: aBox inFrontOf: bBox	[ ^super add: (aBox onList: self) before: bBox ]
BoxList add: aBox behind: bBox		[ ^super add: (aBox onList: self) after: bBox ]

BoxList addFirst: aBox		[ ^self shouldNotImplement: #addFirst: ]
BoxList addLast: aBox		[ ^self shouldNotImplement: #addLast: ]
BoxList add: aBox		[ ^self shouldNotImplement: #add: ]

BoxList back			[ ^super last ]
BoxList front			[ ^super first ]
BoxList removeBack		[ ^super removeLast ]
BoxList removeFront		[ ^super removeFirst ]

BoxList detectFrontToBack: unaryBlock	[ ^super detect: unaryBlock ]

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

Box : Link ( myList position extent properties contents )

Box position	[ ^position ]
Box extent	[ ^extent ]
Box bounds [ ^Rectangle origin: self position extent: extent ]

Box new
[
    self := super new.
    position := PointZero.
    extent := PointZero.
]

Box with: aBox
[
    self := self new.
    ^self add: aBox
]

Box position: aPoint	[ position := aPoint ]

Box extent: aPoint
[
    self layout
	ifTrue: [ self layout layout: self in: aPoint ]
	ifFalse: [ self layoutExtent: aPoint]
]

Box layoutExtent: aPoint
[
    "This is almost private. Only Layout uses this method"
    extent := aPoint.
]

Box width		[ ^extent x ]
Box width: aNumber	[ self extent: aNumber, self height ]
Box height		[ ^extent y ]
Box height: aNumber	[ self extent: self width, aNumber ]

Box layoutContents
[
    self extent: self extent
]

Box onList: aList	[ myList := aList ]
Box removeFromList	[ myList ifNotNil: [self damaged. myList remove: self ].  myList := nil ]

Box raise		[ prevLink ifTrue: [myList remove: self; addFront: self] ]
Box lower		[ nextLink ifTrue: [myList remove: self; addBack: self] ]

Box contents		[ ^contents ifTrue: [contents] ifFalse: [contents := BoxList forBox: self] ]

Box addFront: aBox		[ self damaged: aBox bounds. ^self contents addFront: aBox ]
Box addBack: aBox		[ self damaged: aBox bounds. ^self contents addBack:  aBox ]
Box add: aBox inFrontOf: bBox	[ self damaged: aBox bounds. ^self contents add: (aBox onList: self) inFrontOf: bBox ]
Box add: aBox behind: bBox	[ self damaged: aBox bounds. ^self contents add: (aBox onList: self) behind: bBox ]
Box add: aBox			[ self damaged: aBox bounds. ^self contents addBack:  aBox ]

Box isEmpty		[ ^self notEmpty not ]
Box notEmpty		[ ^contents and: [contents notEmpty] ]

Box back		[ ^contents ifTrue: [contents last] ]
Box front		[ ^contents ifTrue: [contents first] ]

Box do: unaryBlock		[ ^contents ifTrue: [contents do: unaryBlock] ]
Box doFrontToBack: unaryBlock	[ ^contents ifTrue: [contents do: unaryBlock] ]
Box doBackToFront: unaryBlock	[ ^contents ifTrue: [contents reverseDo: unaryBlock] ]

Box	globalPosition	[ ^position + myList globalPosition ]
BoxList	globalPosition	[ ^myBox globalPosition ]

Box damaged: aRectangle		[ myList ifNotNil: [ myList damaged: aRectangle ]]
BoxList damaged: aRectangle	[ myBox ifNotNil: [ myBox damaged: aRectangle + myBox position ]]
Box damaged [ self damaged: self bounds ]

Box includesGlobalPoint: aPoint
[
    | gpos |
    gpos := self globalPosition.
    ^gpos <= aPoint and: [aPoint < (gpos + extent)]
]

Box boxUnder: aPoint
[
    | box |
    (box := self subBoxUnder: aPoint)
	ifFalse:
	    [box := (position <= aPoint and: [aPoint < (position + extent)])
		 ifTrue: [self]].
    ^box
]

Box subBoxUnder: aPoint
[
    aPoint := aPoint - position.
    (self clip and: [(PointZero < aPoint) not or: [(aPoint < extent) not]]) ifTrue: [^nil].
    self doFrontToBack: [:box | (box := box boxUnder: aPoint) ifTrue: [^box]].
    ^nil
]

Box immediateBoxUnder: aPoint
[
    aPoint := aPoint - position.
    self doFrontToBack: [:box | (box position <= aPoint and: [aPoint < (box position + box extent)]) ifTrue: [^box]].
    ^nil
]

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

Box properties	[ ^properties ifTrue: [properties] ifFalse: [properties := IdentityDictionary new] ]

Box propertyAt: aSymbol put: aValue		[  self properties at: aSymbol put: aValue ]
Box propertyAt: aSymbol				[ ^properties ifTrue: [properties at: aSymbol ifAbsent: []] ]
Box propertyAt: aSymbol ifAbsent: valueBlock	[ ^properties ifTrue: [properties at: aSymbol ifAbsent: valueBlock] ]

Box background	[ ^self propertyAt: #background ]	Box background: aColor	 [ ^self propertyAt: #background put: aColor  ]
Box border	[ ^self propertyAt: #border     ]	Box border:     aColor	 [ ^self propertyAt: #border     put: aColor  ]
Box foreground	[ ^self propertyAt: #foreground ]	Box foreground: aColor	 [ ^self propertyAt: #foreground put: aColor  ]
Box layout	[ ^self propertyAt: #layout     ]	Box layout: aLayout	 [ ^self propertyAt: #layout     put: aLayout ]
Box motion	[ ^self propertyAt: #motion ]		Box motion: aHandler	 [ ^self propertyAt: #motion	 put: aHandler ]
Box buttonDown	[ ^self propertyAt: #buttonDown ]	Box buttonDown: aHandler [ ^self propertyAt: #buttonDown put: aHandler ]
Box buttonUp	[ ^self propertyAt: #buttonUp ]		Box buttonUp: aHandler	 [ ^self propertyAt: #buttonUp	 put: aHandler ]
Box keyDown	[ ^self propertyAt: #keyDown ]		Box keyDown: aHandler	 [ ^self propertyAt: #keyDown	 put: aHandler ]
Box keyUp	[ ^self propertyAt: #keyUp ]		Box keyUp: aHandler	 [ ^self propertyAt: #keyUp	 put: aHandler ]
Box clip	[ ^self propertyAt: #clip ]		Box clip: aBoolean	 [ ^self propertyAt: #clip	 put: aBoolean ]
Box hidden	[ ^self propertyAt: #hidden ]		Box hidden: aBoolean	 [ ^self propertyAt: #hidden	 put: aBoolean ]

Box printOn: aStream
[
    super printOn: aStream.
    aStream
	nextPut: $(;
	print: position;
	nextPut: $+;
	print: extent;
	nextPut: $)
]

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

Box drawOn: aContext
[
    | bg bd fg |
    self hidden ifTrue: [ ^self ].
    bg := self drawBackgroundOn: aContext.
    fg := self drawForegroundOn: aContext.
    bd := self drawBorderOn:     aContext.
    (bg or: [fg or: [bd or: [self notEmpty]]]) ifFalse: [self drawInvalidOn: aContext].
]

Box drawBackgroundOn: aContext
[
    | bg |
    ^(bg := self background)
	ifTrue:
	    [aContext
		 saveColor;
		 color: bg; 
		 fillRectangle: position extent: extent;
		 restoreColor]
]

Box drawBorderOn: aContext
[
    | bd |
    ^(bd := self border)
	ifTrue:
	    [aContext
		 saveColor;
		 color: bd; 
		 drawRectangle: position extent: extent - (1,1);
		 restoreColor]
]

Box drawForegroundOn: aContext
[
    ^contents
	ifTrue:
	   [| fg |
	    fg := self foreground.
	    fg ifTrue: [aContext saveColor; color: fg].
	    self drawContentsOn: aContext.
	    fg ifTrue: [aContext restoreColor]]
]

Box drawContentsOn: aContext
[
    ^contents
	ifTrue:
	   [aContext saveTransform; translate: position.
	    self clip
		ifTrue: [aContext clipBy: (Rectangle origin: PointZero extent: extent)
		    during: [ :context | self doBackToFront: [:box | box drawOn: context]]]
		ifFalse: [ self doBackToFront: [:box | box drawOn: aContext]].
	    aContext restoreTransform]
]

Box drawInvalidOn: aContext
[
    | corner |
    corner := position + extent - (1,1).
    aContext
	saveColor;
	color: ColorRed; 
	fillRectangle: position extent: extent;
	color: ColorYellow; 
	drawRectangle: position extent: extent;
	drawLine:      position to: corner;
	drawLine:      position x , corner y to: corner x , position y;
	restoreColor
]

Box findOne: aBlock
[
    (aBlock value: self) ifTrue: [ ^self ].
    self contents do: [ :each | (each findOne: aBlock) ifTrue: [ ^each ]].
    ^nil
]

Box dumpTree [ self dumpTree: 0 ]

Box dumpTree: indent
[
    0 to: indent - 1 do: [ :i | StdOut nextPutAll: '  ' ].
    self println.
    self do: [ :each | each dumpTree: indent + 1 ].
]

Box naturalExtent
[
    | x y |
    x := y := 0.
    self do: [:g |
	x := x max: g position x + g extent x.
	y := y max: g position y + g extent y].
    ^x ceiling , y ceiling
]

Box fitContents [ extent := self naturalExtent ] "todo: remove"

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

HandExtent := [ 1,1 ]
HandOffset := [ 0,0 ]


Hand : Box ( window focus eventHandlers )

Hand withWindow: aWindow
[
    self := self new.
    window := aWindow.
    eventHandlers := LinkedList new.
]

Hand globalPosition	[ ^position ]
Hand window		[ ^window ]

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

Window : Box ( surface hand damage )

Window surface	[ ^surface ]
Window hand	[ ^hand ]
Window default [ ^self propertyAt: #default ]
Window globalPosition	[ ^PointZero ]

Window new: dimensions
[
    self := super new.
    Window propertyAt: #default put: self.
    surface := Surface new: dimensions.
    position := PointZero.
    extent := dimensions.
    self background: (Color withR: 224 withG: 224 withB: 240).

    self damaged.
    hand := (Hand withWindow: self)
	position: dimensions / 2 - HandOffset;
	extent: HandExtent;
	background: ColorBlue;
	border: ColorGreen.
]

Window draw
[
    | context |
    damage ifNil: [ ^self ].
    context := surface newContext.
    self drawOn: context.
    hand drawOn: context.
    context flush: damage.
    damage := nil.
]

Window damaged: aRectangle
[
    damage := damage ifTrue: [damage union: aRectangle] ifFalse: [aRectangle].
]

Window mainLoop [[self draw; dispatchEvent] repeat]

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

ImageBox : Box ( image )
ImageBox newImage: anImage
[
    self := self new.
    self image: anImage.
]

ImageBox image [ ^image ]
ImageBox image: anImage
[
    image := anImage.
    self extent: anImage extent.
]

ImageBox drawOn: aContext
[
    self drawBackgroundOn: aContext.
    aContext saveTransform; translate: position.
    image drawOn: aContext.
    aContext restoreTransform.
]