-- <<<- ------------------------------------------------------------------------ class PuppetPart (Thrower, Catcher, Perpetrator) instance variables frameJoints superJoint superJointName superPart superXoffset superYoffset subParts tightness joined coverSuperPart locked end method init self {class PuppetPart} #rest args #key \ frameJoints: (#(:)) \ superJoint: (undefined) \ superPart: (undefined) \ superXoffset: (0) \ superYoffset: (0) \ subParts: (#(:)) \ tightness: (1) \ coverSuperPart: (true) \ locked: (false) \ -> ( apply nextMethod self args self.frameJoints := frameJoints self.superJoint := superJoint self.superJointName := superJoint self.superPart := superPart self.superXoffset := superXoffset self.superYoffset := superYoffset self.subParts := subParts self.tightness := tightness self.coverSuperPart := coverSuperPart self.locked := locked self.joined := (superPart != undefined) ) method cloneArgs self {class PuppetPart} -> ( local args := nextMethod self addMany args #( @tightness, self.tightness, @superJointName, self.superJointName, @frameJoints, self.frameJoints, @coverSuperPart, self.coverSuperPart ) return args ) method layoutParts self {class PuppetPart} -> ( local x := self.x local y := self.y forEachBinding self.subParts (partName subPart xxx -> local joint := self.frameJoints[partName] -- joint ::= #(jointPoint, jointChannel, jointRect) if (joint == empty) then ( hideAll subPart ) else ( local pt := joint[1] subPart.x := (x + pt.x + subPart.superXoffset) subPart.y := (y + pt.y + subPart.superYoffset) layoutParts subPart showAll subPart self.presentedBy ) ) ok ) method layupParts self {class PuppetPart} sendingSubPart -> ( local joint := self.frameJoints[sendingSubPart.superJointName] -- joint ::= #(jointPoint, jointChannel, jointRect) local pt := joint[1] -- TODO: check to make sure if superX&Yoffsets are right local subX := sendingSubPart.x - sendingSubPart.superXoffset local subY := sendingSubPart.y - sendingSubPart.superYoffset local x := subX - pt.x local y := subY - pt.y self.x := x self.y := y local sup := self.superPart if (sup != undefined) do ( layupParts sup self ) forEachBinding self.subParts (partName subPart xxx -> if (subPart != sendingSubPart) do ( local joint := self.frameJoints[partName] if (joint== empty) then ( hideAll subPart ) else ( local pt := joint[1] subPart.x := (x + pt.x) subPart.y := (y + pt.y) layoutParts subPart showAll subPart self.presentedBy ) ) ) ok ) method hideAll self {class PuppetPart} -> ( -- local pb := self.presentedBy -- if (pb != undefined) do (deleteOne pb self) hide self forEach self.subParts (part xxx -> hideAll part ) ok ) method showAll self {class PuppetPart} pb -> ( -- if (pb != undefined) do (prependNew pb self) show self forEach self.subParts (part xxx -> showAll part pb ) ok ) method handleDynamics self {class PuppetPart} -> ( ) method doDynamics self {class PuppetPart} -> ( if (self.superPart == undefined) do ( nextMethod self ) ) method doPhysics self {class PuppetPart} -> ( handleDynamics self local doit := false if ((not self.joined) or (self.dragging)) then ( doit := true ) else ( local superPart := self.superPart local superJointName := self.superJointName local joint := superPart.frameJoints[superJointName] if (joint == empty) then ( removeSubPart superPart self doit := true ) else ( local pt := joint[1] local r := joint[3] local sx := superPart.x + pt.x + self.superXoffset local sy := superPart.y + pt.y + self.superYoffset local x := sx - self.x local y := sy - self.y if ((x != 0) or (y != 0)) then ( local dx, dy if (((abs x) + (abs y)) < 8) then ( dx := x dy := y ) else ( local tightness := self.tightness dx := (x * tightness) as ImmediateFloat dy := (y * tightness) as ImmediateFloat ) self.x := round (self.x + dx) self.y := round (self.y + dy) self.dx := dx self.dy := dy self.stationary := false ) else ( self.dx := 0 self.dy := 0 self.stationary := true ) ) ) if (doit) then ( nextMethod self ) else ( maybeDoCatches self ) handleDragged self ) method handleDragged self {class PuppetPart} -> ( forEach (copy self.subParts) (p xxx -> doPhysics p ) ok ) method get jointNames self {class PuppetPart} -> ( local joints := self.frameJoints local names := new Array initialSize: (size joints) forEachBinding joints (key val xxx -> append names key) ok names ) method addSubPart self {class PuppetPart} jointName subPart -> ( joinSound() local oldSuper := subPart.superPart if (oldSuper != undefined) do ( removeSubPart oldSuper subPart ) local subParts := self.subParts add subParts jointName subPart subPart.superPart := self subPart.joined := true subPart.superJointName := jointName local myz := self.z local subz := subPart.z local z if (subPart.coverSuperPart) then ( z := myz + 1 ) else ( z := myz - 1 ) if (z != subz) do ( orderZ subPart z ) jointName ) method orderZ self {class PuppetPart} z -> ( self.z := z forEach self.subParts (part xxx -> orderZ part (if (part.coverSuperPart) then (z + 1) else (z - 1)) ) ok ) method changeZ self {class PuppetPart} -> ( orderZ self self.z ) method removeSubPart self {class PuppetPart} subPart -> ( disjoinSound() local subParts := self.subParts if (isMember subParts subPart) do ( deleteOne subParts subPart subPart.superPart := undefined subPart.joined := false ) ) method gotoRoom self {class PuppetPart} rm -> ( local result := undefined local p := self.superPart if (p == undefined) then ( result := gotoRoomReally self rm if (result != undefined) do ( layoutParts self ) ) else ( result := gotoRoom p rm ) return result ) method gotoRoomReally self {class PuppetPart} rm -> ( if ((self.room != undefined) and (self.lockedInRoom)) do ( return undefined ) local p := self.subParts forEach self.subParts (part xxx -> if ((gotoRoomReally part rm) == undefined) do ( removeSubPart self part ) ) ok return (nextMethod self rm) ) method trackStart self {class PuppetPart} service ev state -> ( local sup if (self.locked and ((sup := self.superPart) != undefined)) then ( -- Delegate tracking to superpart if we're locked. local dx := sup.x - self.x local dy := sup.y - self.y local coords := ev.localCoords coords.x := coords.x + dx coords.y := coords.y + dy state[@trackMatrix] := translate state[@trackMatrix] dx dy state[@trackTarget] := sup trackStart sup service ev state ) else ( nextMethod self service ev state ) ) method trackMove self {class PuppetPart} service ev -> ( local sup := self.superPart if (sup != undefined) do ( local coords := ev.localCoords local dx := coords.x - service.firstx local dy := coords.y - service.firsty if (((dx * dx) + (dy * dy) >= 8)) do ( removeSubPart sup self ) ) nextMethod self service ev ) method trackUp self {class PuppetPart} service ev -> ( local coords := ev.localCoords local dx := coords.x - service.firstx local dy := coords.y - service.firsty if (((dx * dx) + (dy * dy) < 8)) then ( nextMethod self service ev trackClick self service ev ) else ( local sup := self.superPart if (sup != undefined) do ( removeSubPart sup self ) nextMethod self service ev ) ) method trackClick self {class PuppetPart} service ev -> ( ) method doCatches self {class PuppetPart} -> ( local pb := self.presentedBy if (pb != undefined) do ( local x := self.x local y := self.y local bb := self.bbox local mybox := new Rect x1: (x + bb.x1) \ y1: (y + bb.y1) \ x2: (x + bb.x2) \ y2: (y + bb.y2) forEach (findAllInStencil pb mybox) (s xxx -> if ((s != self) and (isAKindOf s Catcher)) do ( handleOverlap s self ) ) ok ) ) method canCatch self {class PuppetPart} t -> ( if ((not isAKindOf t PuppetPart) or (self.dragging) or (t.dragging) or (local ssp := self.superPart; local tsp := t.superPart; -- both attached to someone else, or already attached to each other ((ssp != undefined) and (tsp != undefined)) or (ssp == t) or (tsp == self))) do ( return false ) return true ) method handleCatch self {class PuppetPart} t -> ( local subPart, superPart, part, pt if (not (isAKindOf t PuppetPart)) then ( return (handleCatchOther self t) ) else ( subPart := undefined superPart := undefined if ((rand 2) == 0) then ( superPart := t subPart := self ) else ( superPart := self subPart := t ) if (subPart.locked) do ( return (handleCatchOther self t) ) -- No circular trees! part := superPart.superPart repeat while (part != undefined) do ( if (part == subPart) do ( return (handleCatchOther self t) ) part := part.superPart ) local joints := superPart.frameJoints local sjName := superPart.superJoint local x := subPart.x local y := subPart.y local sx := x - superPart.x local sy := y - superPart.y local closestDist := posInf local closestJointName := undefined forEachBinding joints (jointName joint xxx -> pt := joint[1] local dx := sx - pt.x local dy := sy - pt.y local dist := (dx * dx) + (dy * dy) if (dist < closestDist) do ( closestDist := dist closestJointName := jointName ) ) ok if ((closestJointName == undefined) or (closestDist > (225))) do ( -- 225 is radius 15^2 return (handleCatchOther self t) ) local prsub := subPart.presentedBy local prsuper := superPart.presentedBy if (prsub != prsuper) do ( local pt := new Point x: subPart.x y: subPart.y localToWindow prsub pt @mutate windowToLocal prsuper pt @mutate deleteOne prsub subPart prepend prsuper subPart subPart.x := pt.x subPart.y := pt.y -- dicey, depends on cached group location of 0,0 if (isAKindOf prsub.presentedBy CachedPresenter) do ( invalidateRegion prsub.presentedBy \ (getBoundaryInParent subPart).bbox ) if (isAKindOf prsuper.presentedBy CachedPresenter) do ( invalidateRegion prsuper.presentedBy \ (getBoundaryInParent subPart).bbox ) ) addSubPart superPart closestJointName subPart ) ) method handleCatchOther self {class PuppetPart} t -> ( ) ------------------------------------------------------------------------ class PuppetShape (PuppetPart, TwoDShape) end ------------------------------------------------------------------------ class PuppetLine (PuppetShape) instance variables lineTip end method init self {class PuppetLine} #rest args #key \ dx: (8) \ dy: (8) \ boundary: (new Line x1: 0 y1: 0 x2: dx y2: dy) \ stroke: ((local br := new Brush color: redColor br.lineWidth := 4 br)) \ lineTip: (new Point x: dx y: dy) \ frameJoints: (#(@tip: #(lineTip, 1, new Rect))) \ -> ( apply nextMethod self \ boundary: boundary \ stroke: stroke \ frameJoints: frameJoints \ args self.lineTip := lineTip ) method doDynamics self {class PuppetLine} -> ( local lineTip := self.lineTip local x := lineTip.x local y := lineTip.y local line := self.boundary if ((line.x2 != x) or (line.y2 != y)) do ( notifyChanged self true line.x2 := x line.y2 := y notifyChanged self true ) nextMethod self ) ------------------------------------------------------------------------ class AnimationPuppetPartMedia (PuppetPart, Animation, TwoDShape) instance variables animationFrames mediaArg end method init self {class AnimationPuppetPartMedia} #rest args #key \ media: \ superJoint: (undefined) \ -> ( self.mediaArg := media local actions := media[@Actions] self.animationActions := actions if (superJoint == undefined) do ( local frames := getFirst actions superJoint := frames[1][4] ) self.superJoint := superJoint self.superJointName := superJoint -- XXX apply nextMethod self args ) method cloneArgs self {class AnimationPuppetPartMedia} -> ( local args := nextMethod self addMany args #( @media, self.mediaArg, @x, self.x, @y, self.y, @superJoint, self.superJoint, -- XXX @act, self.animationAction, @animationActive, self.animationActive, @animationPaused, self.animationPaused, @animationSpeed, self.animationSpeed, @animationLooping, self.animationLooping, @animationBackAndForth, self.animationBackAndForth, @animationBeginHook, self.animationBeginHook, @animationEndHook, self.animationEndHook, @animationFrameHook, self.animationFrameHook, @animationLooping, self.animationLooping, @animationAction, self.animationAction, @animationFrame, self.animationFrame, @animationFirstFrame, self.animationFirstFrame, @animationLastFrame, self.animationLastFrame, @animationActions, self.animationActions ) return args ) method setAction self {class AnimationPuppetPartMedia} actionName -> ( local frames := self.animationActions[actionName] self.animationFrames := frames self.animationFirstFrame := 1 self.animationLastFrame := size frames nextMethod self actionName ) method gotoFrame self {class AnimationPuppetPartMedia} frameNumber -> ( local frames := self.animationFrames local frame := frames[frameNumber] -- frame := #(bm, firstChannel, lastChannel, hotName, joints, sound, hotspot) local bm := frame[1] local oldb := self.boundary if (bm !== oldb) do ( self.boundary := bm if ((theSmallMode or (totalFreeSystemSpace() < theMinFreeSpace)) and (isAKindOf oldb Bitmap)) do ( makePurgeable oldb ) ) self.frameJoints := frame[5] local sound := frame[6] if ((sound != undefined) and (sound != empty)) do ( playSoundEffect sound ) ) method purgeStuff self {class AnimationPuppetPartMedia} -> ( nextMethod self forEach self.animationActions (frames xxx -> forEach frames (frame xxx -> makePurgeable frame[1] makePurgeable frame[5] makePurgeable frame[6] ) ok ) ok ok ) ------------------------------------------------------------------------ class AnimatedProduct (Product, Animation, TwoDShape) instance variables cycleDir actNames actIndex action end class method setupAnimationImporter self {class AnimatedProduct} w -> ( Animation.importMedia := (media -> local mediaClass := findMediaClass Animation media local anim := object (AnimatedProduct, mediaClass) media: media end anim.x := ((rand 600) + 20) anim.y := ((rand 400) + 40) addToRoom theRoom anim true ) ) method init self {class AnimatedProduct} #rest args #key \ media: \ act: (undefined) \ animationAction: (undefined) \ animationFrame: (1) \ -> ( apply nextMethod self args self.cycleDir := 1 self.actIndex := 1 self.action := undefined local acts := media[@DemoActions] if ((acts == undefined) or (acts == empty)) do ( acts := getActions self ) self.actNames := acts if (act == undefined) do ( act := animationAction ) if (act == undefined) do ( act := self.actNames[1] ) startAction self act gotoFrame self animationFrame ) method cloneArgs self {class AnimatedProduct} -> ( local args := nextMethod self addMany args #( @act, self.animationAction ) return args ) method createDefaultAction self {class AnimatedProduct} -> ( return (new PerpetrateAction \ name: self.animationAction \ perpetrator: self \ script: (a t p -> perpetrate self a)) ) method perpetrate self {class AnimatedProduct} act -> ( local actNames := getActions self local actName := act.name if (isMember actNames actName) then ( startAction self act.name ) else ( cancelAction self ) self.action := act -- Don't call nextMethod, since Perpetrator's perpetrate calls handleAction, -- but we want to defer that until the end of the animation, by calling -- it in notifyEndAction, below. -- nextMethod self act ) method notifyEndAction self {class AnimatedProduct} act frame -> ( local action := self.action if ((action <> undefined) and (theConductor <> undefined) and (frame == self.animationLastFrame)) do ( self.action := undefined handleAction theConductor action ) nextMethod self act frame ) method getActions self {class AnimatedProduct} -> ( actionNames self ) method handleDynamics self {class AnimatedProduct} -> ( tickleAnimation self ) method trackClick self {class AnimatedProduct} service ev -> ( local i := self.actIndex local n := self.actNames i := 1 + (mod (i + self.cycleDir - 1) (size n)) self.actIndex := i local actionName := n[i] local act := new PerpetrateAction perpetrator:self name:actionName self.action := act startAction self act.name ) ------------------------------------------------------------------------ class AnimatedPuppetPart (AnimatedProduct, AnimationPuppetPartMedia) end method init self {class AnimatedPuppetPart} #rest args #key \ actions: (#(:)) \ media: (#(@Actions: actions)) \ -> ( apply nextMethod self \ media: media \ args ) ------------------------------------------------------------------------ -- >>>