{ import Smalltalk/kernel }
{ import Smalltalk/geometry }
{ import XWindow }

Event : Object ()
  MotionEvent : Event ( position modifiers )	"MoionEvents include keybboard modifiers"
    KeyEvent : MotionEvent ( character )	"KeyEvents include motion info"
      KeyPressEvent : KeyEvent ()
      KeyReleaseEvent : KeyEvent ()
    ButtonEvent : MotionEvent ( button )	"ButtonEvents include motion info"
      ButtonPressEvent : ButtonEvent ()
      ButtonReleaseEvent : ButtonEvent ()

MotionEvent position: aPoint modifiers: modifierMask
[
    self := self new.
    position := aPoint.
    modifiers := modifierMask.
]

MotionEvent position	[ ^position ]
MotionEvent modifiers	[ ^modifiers ]

MotionEvent printOn: aStream
[
    super printOn: aStream.
    aStream
	nextPut:    $(;
	print:      position;
	space;
	nextPutAll: modifiers hex8;
	nextPut:    $)
]

Event isMotion		[ ^false ]
MotionEvent isMotion	[ ^true ]

KeyEvent position: aPoint modifiers: modifierMask character: aCharacter
[
    self := self position: aPoint modifiers: modifierMask.
    character := aCharacter.
]

KeyEvent character	[ ^character ]

KeyEvent printOn: aStream
[
    super printOn: aStream.
    aStream
	nextPut: $(;
	print:   character;
	nextPut: $)
]

Event isKey			[ ^false ]
KeyEvent isKey			[ ^true ]

Event isKeyPress		[ ^false ]
KeyPressEvent isKeyPress	[ ^true ]

Event isKeyRelease		[ ^false ]
KeyReleaseEvent isKeyRelease	[ ^true ]

ButtonEvent position: aPoint modifiers: modifierMask button: aButton
[
    self := self position: aPoint modifiers: modifierMask.
    button := aButton.
]

ButtonEvent button	[ ^button ]

ButtonEvent printOn: aStream
[
    super printOn: aStream.
    aStream
	nextPut: $(;
	print:   button;
	nextPut: $)
]

Event isButton				[ ^false ]
ButtonEvent isButton			[ ^true ]

Event isButtonPress			[ ^false ]
ButtonPressEvent isButtonPress		[ ^true ]

Event isButtonRelease			[ ^false ]
ButtonReleaseEvent isButtonRelease	[ ^true ]

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

SimpleXWindow : XWindow ( graphicsContext )

SimpleXWindow withGraphicsContext: aGraphicsContext
[
    self := self new.
    graphicsContext := aGraphicsContext
]

SimpleXWindow fromWindow: aWindow
[
    self := self withGraphicsContext: aWindow display defaultGraphicsContext.
    display := aWindow display.
    _window := aWindow _window.
    self
        changeAttributes: ((XSetWindowAttributes new) eventMask: 0x1ffffff - 128; yourself)
        mask:             XSetWindowAttributes eventMaskMask.
    self map.
    display synchronise.
]

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

SimpleXDisplay : XDisplay ()

SimpleXDisplay newWindowExtent: extentPoint
[
    ^SimpleXWindow fromWindow: (self defaultRootWindow
        createSimpleWindowX: 0 y: 0 width: extentPoint x height: extentPoint y borderWidth: 0 border: 0 background: -1)
]

SimpleXDisplay newWindow
[
    ^self newWindowExtent: 640 @ 480
]

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

SimpleXDisplay undefined: event		[ self error: 'undefined event' ]
SimpleXDisplay keyPress: event		[ ^KeyPressEvent      position: event keyPosition    modifiers: event keyState    character: event keyKeycode ]
SimpleXDisplay keyRelease: event	[ ^KeyReleaseEvent    position: event keyPosition    modifiers: event keyState    character: event keyKeycode ]
SimpleXDisplay buttonPress: event	[ ^ButtonPressEvent   position: event buttonPosition modifiers: event buttonState button: event buttonButton ]
SimpleXDisplay buttonRelease: event	[ ^ButtonReleaseEvent position: event buttonPosition modifiers: event buttonState button: event buttonButton ]
SimpleXDisplay motionNotify: event	[ ^MotionEvent        position: event motionPosition modifiers: event motionState ]

SimpleXDisplay enterNotify: event	[ 'enterNotify'       println.  ^nil ]
SimpleXDisplay leaveNotify: event	[ 'leaveNotify'       println.  ^nil ]
SimpleXDisplay focusIn: event		[ 'focusIn'           println.  ^nil ]
SimpleXDisplay focusOut: event		[ 'focusOut'          println.  ^nil ]
SimpleXDisplay keymapNotify: event	[ 'keymapNotify'      println.  ^nil ]
SimpleXDisplay expose: event		[ 'expose'            println.  ^nil ]
SimpleXDisplay graphicsExpose: event	[ 'graphicsExpose'    println.  ^nil ]
SimpleXDisplay noExpose: event		[ 'noExpose'          println.  ^nil ]
SimpleXDisplay visibilityNotify: event	[ 'visibilityNotify'  println.  ^nil ]
SimpleXDisplay createNotify: event	[ 'createNotify'      println.  ^nil ]
SimpleXDisplay destroyNotify: event	[ 'destroyNotify'     println.  ^nil ]
SimpleXDisplay unmapNotify: event	[ 'unmapNotify'       println.  ^nil ]
SimpleXDisplay mapNotify: event		[ 'mapNotify'         println.  ^nil ]
SimpleXDisplay mapRequest: event	[ 'mapRequest'        println.  ^nil ]
SimpleXDisplay reparentNotify: event	[ 'reparentNotify'    println.  ^nil ]
SimpleXDisplay configureNotify: event	[ 'configureNotify'   println.  ^nil ]
SimpleXDisplay configureRequest: event	[ 'configureRequest'  println.  ^nil ]
SimpleXDisplay gravityNotify: event	[ 'gravityNotify'     println.  ^nil ]
SimpleXDisplay resizeRequest: event	[ 'resizeRequest'     println.  ^nil ]
SimpleXDisplay circulateNotify: event	[ 'circulateNotify'   println.  ^nil ]
SimpleXDisplay circulateRequest: event	[ 'circulateRequest'  println.  ^nil ]
SimpleXDisplay propertyNotify: event	[ 'propertyNotify'    println.  ^nil ]
SimpleXDisplay selectionClear: event	[ 'selectionClear'    println.  ^nil ]
SimpleXDisplay selectionRequest: event	[ 'selectionRequest'  println.  ^nil ]
SimpleXDisplay selectionNotify: event	[ 'selectionNotify'   println.  ^nil ]
SimpleXDisplay colormapNotify: event	[ 'colormapNotify'    println.  ^nil ]
SimpleXDisplay clientMessage: event	[ 'clientMessage'     println.  ^nil ]
SimpleXDisplay mappingNotify: event	[ 'mappingNotify'     println.  ^nil ]

SimpleXDisplay nextEvent: anXEvent
[
    ^self perform: (self eventNames at: anXEvent type) with: anXEvent
]

SimpleXDisplay nextEvent
[
    ^self nextEvent: (super nextEvent)
]

SimpleXDisplay nextEventOrNil
[
    ^self pending = 0 ifFalse: [self nextEvent]
]

SimpleXWindow nextEvent
[
    | anXEvent anEvent  |
    anXEvent := XEvent new.
    [display windowEvent: _window mask: 0x1ffffff - 128 into: anXEvent.
     (anEvent := display nextEvent: anXEvent) isNil]
        whileTrue.
    ^anEvent
]

SimpleXWindow nextEventOrNil
[
    | anEvent |
    anEvent := XEvent new.
    ^(display checkWindowEvent: _window mask: 0x1ffffff - 128 into: anEvent)
        ifTrue: [display nextEvent: anEvent]
]

SimpleXWindow drawPoint: aPoint
[
    self drawPoint: aPoint context: graphicsContext
]

SimpleXWindow drawBitmap: aWordArray extent: extentPoint clipped: clippingRectangle
[
    self drawBitmap: aWordArray extent: extentPoint clipped: clippingRectangle context: graphicsContext
]

SimpleXWindow drawBitmap: aWordArray extent: extentPoint
[
    self drawBitmap: aWordArray extent: extentPoint clipped: (0 @ 0 + extentPoint) context: graphicsContext
]

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

SimpleForm : Object ( width height bits )

SimpleForm newExtent: aPoint
[
    self := self new.
    width  := aPoint x.
    height := aPoint y.
    bits   := WordArray new: width * height.
]

SimpleForm pixelAt: aPoint
[
    ^bits at: aPoint y * width + aPoint x
]

SimpleForm pixelAt: aPoint put: aPixel
[
    ^bits at: aPoint y * width + aPoint x put: aPixel
]

SimpleForm invertPixelAt: aPoint
[
    self pixelAt: aPoint put: ((self pixelAt: aPoint) bitXor: 0xffffffff)
]

SimpleForm displayOn: aWindow clipped: aRectangle
[
    aWindow drawBitmap: bits extent: width @ height clipped: aRectangle
]

SimpleForm displayOn: aWindow
[
    aWindow drawBitmap: bits extent: width @ height clipped: (0 @ 0 corner: width @ height)
]

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

Window : Object ( platformWindow )

Window on: aWindow
[
    self := self new.
    platformWindow := aWindow.
]

Window nextEvent
[
    ^platformWindow nextEvent
]

Window drawPoint: aPoint
[
    platformWindow drawPoint: aPoint
]


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

[
    | display window form drawing |
    display := SimpleXDisplay open": ':0.0'".
    window := display newWindowExtent: 800 @ 600.
    form := SimpleForm newExtent: window extent.
    0 to: window width - 1 do: [:x |
        0 to: window height - 1 do: [:y |
            form pixelAt: x @ y put: (x + ((x + y) * 256) + (y * 65536))]].
    form displayOn: window.
    drawing := false.
    [
        | event |
	event := window nextEvent.
	(event isButton) ifTrue: [drawing := event isButtonPress].
        drawing ifTrue: [form invertPixelAt: event position; displayOn: window clipped: (event position extent: 1 @ 1)].
        (event isKeyPress and: [event character = $q asciiValue]) ifTrue: [Smalltalk quit].
    ] repeat.
]