-- <<<- ------------------------------------------------------------------------ class OffscreenGround (Catcher, TrackerGroupPresenter) instance variables cache end method init self {class OffscreenGround} #rest args #key \ cache: \ -> ( apply nextMethod self args self.cache := cache ) method get presentedBy self {class OffscreenGround} -> ( self.cache ) ------------------------------------------------------------------------ class Ground (Catcher, TrackerCachedPresenter) end method init self {class Ground} #rest args #key \ offscreen: (new OffscreenGround cache: self) \ -> ( apply nextMethod self offscreen:offscreen args ) method trackStart self {class Ground} service ev state -> ( local result := nextMethod self service ev state if (result) then ( local target := state[@trackTarget] if (target.presentedBy == self.offscreen) do ( local reg := (getBoundaryInParent target).bbox deleteOne self.offscreen target target.x := target.x + self.x target.y := target.y + self.y prepend self.presentedBy target state[@trackMatrix] := translate state[@trackMatrix] self.x self.y invalidateRegion self reg ) ) else ( state[@trackConstraint] := @vertical state[@minimumY] := 0 state[@maximumY] := 210 local coords := ev.localCoords state[@trackMatrix] := translate state[@trackMatrix] \ (self.x - coords.x) (self.y - coords.y) result := true ) result ) method trackMove self {class Ground} service ev -> ( local coords := ev.localCoords self.x := coords.x self.y := coords.y ) method handleOverlap self {class Ground} t -> ( local offscreen := self.offscreen local x := t.x - self.x local y := t.y - self.y local coords := new Point x: x y: y local ps := findAllAtPoint offscreen coords forEach ps (p xxx -> if (canObjectDo p handleOverlap) do ( coords.x := x - p.x coords.y := y - p.y if (inside p.boundary coords) do ( handleOverlap p t ) ) ) ok ) ------------------------------------------------------------------------ class ForegroundPuppetShape (PuppetShape) end method init self {class ForegroundPuppetShape} #rest args -> ( apply nextMethod self \ locked: true \ args self.z := -100 ) method trackStart self {class ForegroundPuppetShape} service ev state -> ( false ) method canCatch self {class ForegroundPuppetShape} t -> ( -- XXX This is a kludge. if ((isAKindOf t Thrower) and (isAKindOf t PuppetPart) and (not t.joined) -- and -- Need a way to tell if an object doesn't want to land. -- ((not (isDefined Butterfly)) or -- (not isAKindOf t Butterfly)) ) then ( return (nextMethod self t) ) else ( return false ) ) method handleCatchOther self {class ForegroundPuppetShape} t -> ( local tpb := t.presentedBy local spb := self.presentedBy if (tpb != spb) do ( local pt := new Point x: t.x y: t.y localToWindow tpb pt @mutate windowToLocal spb.presentedBy pt @mutate deleteOne tpb t prepend spb t t.x := pt.x t.y := pt.y local reg := (getBoundaryInParent t).bbox invalidateRegion spb.presentedBy reg ) ) ------------------------------------------------------------------------ ------------------------------------------------------------------------ "ground.sx" -- >>>