FileStream fileIn: 'loadscript.st'.
FileStream fileIn: 'Zorph.st'.

SdlRect extend [
    valuesFromRect: rect [
	self x value: (rect left floor).
	self y value: (rect top floor).
	self w value: (rect width ceiling).
	self h value: (rect height ceiling).
    ]
]

Object subclass: World [
    | rootlens context recogniser dragCentre dragButton renderSemaphore renderProcess damageList |

    initialize [
        context := CairoContext onSurface: (CairoSdlSurface onSdlForm: Display).
        recogniser := GestureRecogniser new target: self.
        damageList := DamageList new initialize.
        SdlEventSource instance handler: recogniser.
	renderSemaphore := Semaphore forMutualExclusion.

	renderSemaphore name: 'World renderSemaphore'.

	renderProcess := [ self renderLoop ] fork.
	renderProcess terminateOnQuit.
	renderProcess name: 'World renderLoop'.
    ]
    
    scene: lens [
        rootlens := lens.
        rootlens addDependent: self.
        self notifyDamage: (Rectangle origin: (0@0) extent: Display extent).
    ]

    paintRect: aRect [
        context resetClip.
        context identityMatrix.
        context newPath.
        context rectangle: aRect.
        context clipPreserve.
        context setSource: Color black.
        context paint.
        "context setSource: Color red.
        context strokePreserve."
        rootlens ifNil: [ ^ self ].
        rootlens paint: context.
    ]

    notifyDamage: rect [
        "Transcript << 'Damage: ' << rect; nl."
        renderSemaphore critical: [damageList addRect: rect.].
    ]

    widgetUnderHand: aHand at: devicePoint [
        ^ self
    ]

    deviceToLocalTransform [
	^ Transform identity
    ]

    handlesKeys [ ^true ]
    keyPressed: sym unicode: unicodeCh modifiers: modifierSet [
	sym == $q ifTrue: [ self handleWMQuitRequest. ]
    ]
    keyReleased: sym unicode: unicodeCh modifiers: modifierSet []

    clicked: button at: aPoint []

    buttonPressed: button at: point over: hover [
        Transcript << 'Click at ' << point; nl.
        dragCentre := point.
        dragButton := button.
    ]
    buttonReleased: button at: point over: hover [
    ]
    allButtonsReleasedAt: aPoint over: aWidget []

    mouseMovedTo: point over: something [
        | d |
        d := dragCentre dist: point.
        (dragButton = 1) ifTrue: [
            | scale |
            scale := 1.0 + (d/1000).
            rootlens camera scaleBy: (scale@scale) about: dragCentre].
        (dragButton = 2) ifTrue: [
	    rootlens camera translateBy: (point - dragCentre).
	    dragCentre := point ].
    ]

    dragStarted: button at: point over: hover []
    dragReleased: button at: point over: hover []

    gainedCursor []
    lostCursor []
    
    handleWMQuitRequest [
        Transcript << 'handleWMQuitRequest'; nl.
	ObjectMemory quit.
    ]

    renderLoop [
	| d damageRects |
	damageRects := (SdlRect type arrayType: 32) new.
	damageRects addToBeFinalized.
	d := Delay forMilliseconds: (1000 / 50).
        "i.e, 50 frames a second, in principle"
	[
            | rectsToUpdate |
	    renderSemaphore critical: [ rectsToUpdate := damageList flush.].
	    rectsToUpdate isEmpty ifFalse: [
                "Transcript << 'Rects to paint: ' << rectsToUpdate size; nl."
		(rectsToUpdate size // 32 + 1) timesRepeat: [
		    | rectsLeft ind |
		    rectsLeft := (rectsToUpdate size) \\ 32.
		    ind := 0.
		    rectsLeft timesRepeat: [
			| rect sdlrect | rect := rectsToUpdate removeFirst.
			self paintRect: rect.
			sdlrect := damageRects addressAt: ind.
			sdlrect valuesFromRect: rect.
			ind := ind + 1].
                    Display updateRectangles: rectsLeft rects: damageRects.]
                ].
	    d wait.
	] repeat.
    ]
]

Object subclass: ZowieDemo [
    | world |
    
    run [
        Processor activeProcess terminateOnQuit.
        self showWorld.
        Semaphore new wait.
    ]
    
    showWorld [
        | lens smalllens slzorph slcamera layer label zorph1 zorph2 rect count startTime d |
        world := World new initialize.
        
        lens := Lens new initialize extent: ((0@0) corner: Display extent).
        lens lookThrough: Camera new initialize.
        layer := Layer new.
        lens camera lookAt: layer.
        
        smalllens := Lens new initialize extent: ((0@0) corner: (96@128)).
        slcamera := TransformedCamera new initialize inner: lens camera.
        "slcamera := Camera new initialize lookAt: layer."
        slcamera scaleBy: (0.1@0.1).
        smalllens lookThrough: slcamera.
        slzorph := Zorph new initialize.
        "slzorph addVisual: (FilledRectangle new extent: ((0@0) corner: (101@101)))."
        slzorph addVisual: smalllens.

        lens addToGlass: slzorph.
        slzorph translateBy: (10@300).
        "lens camera transformView: (Translate by: (100@100)).
        lens camera transformView: ((Scale byFactor: 2) about: (50@50))."
        zorph1 := Zorph new initialize.
        zorph2 := Zorph new initialize.
	label := (Label new text: 'Foobar').
	zorph2 addVisual: label.
	zorph2 translateBy: (110@110).
        "zorph1 transform: ((Rotate by: (Float pi)/4) about: (50@50))."
        rect := FilledRectangle new extent: ((0@0) corner: (100@100)).
        zorph1 addVisual: rect.
        layer addZorph: zorph1.
        layer addZorph: zorph2.
        world scene: lens.
        d := Delay forMilliseconds: 30.
        "[[zorph1 rotateBy: Float pi / 50 about: (50@50).
          d wait] repeat] fork."
        "startTime := Time millisecondClock.
        count := 0.
        [
            zorph1 transform: (Translate by: (5@5)).
            count := count + 1.
            (count \\ 100) = 0 ifTrue: [
                Transcript << count << ' frames, '
                    << (count / ((Time millisecondClock - startTime) / 1000.0))
                    << ' fps'; nl.
                Processor yield].
            (Delay forMilliseconds: 1000) wait.
        ] repeat."
        "zorph1 transform: (Translate by: (5@5))."
    ]

].

Object subclass: DamageList [
    | rects |

    initialize [
        rects := OrderedCollection new.
        ^ self
    ]

    addRect: aRect [
        rects add: aRect.
        ^ self
    ]

    flush [
        | result |
        result := rects asOrderedCollection.
        rects empty.
        ^ result
    ]

]

Eval [
    | s |
    s := Semaphore new.
    [ [ ZowieDemo new run. ] ensure: [ s signal ] ] fork.
    s wait.
]