\ This is the SQUIRREL MODULE \ \ It defines the behavior of a cute little nut-munching squirrel.... \ \ Compound object modules: \ - \ Object files \ sq-head.rwx The head \ sq-legs.rwx The legs \ sq-tail.rwx The tail \ sq-eye.rwx The eye (used twice) \ sq-arms.rwx The arms \ sq-ear.rwx The ear (used twice) \ Headers: \ objects.mh 8800 Module: foo only main also std.mlContext! also foo also definitions BeginModule p" objects.mh" "load fvariable time_offset variable holding_nut variable eye variable leye variable self \ MySelf variable squirrel variable eyeMat variable walktask variable looktask variable munchtask variable blinktask variable vtx variable y \ For the "appearance flash" variable appeartask variable l1 variable l2 BeginStruct Float pX Float pY Float pZ Struct Points : Point 1 Points ; variable braintask \ Brain->Engine Message related variables fvariable start_time \ Start-time of current task fvariable end_time \ The time this task should end fvariable curr_task \ The current task \ Message header: BeginStruct Int msgCode Float startTime Float endTime Struct msgHead \ msgJump / msgRun / msgClimb uses this struct BeginStruct 1 msgHead rnHead Point startPoint Point goalPoint Struct JumpMsg create JmpMsgBuf SizeOf MsgHeader SizeOf JumpMsg + dup allot JmpMsgBuf mhMsgLen ! \ msgTurnHead uses this struct BeginStruct 1 msgHead thHead Float startYaw Float goalYaw Struct TurnHeadMsg create TurnMsgBuf SizeOf MsgHeader SizeOf TurnHeadMsg + dup allot TurnMsgBuf mhMsgLen ! \ msgPickUp / msgLayDown / msgEatUp uses this struct BeginStruct 1 msgHead puHead Int Object Struct PickUpMsg create PickMsgBuf SizeOf MsgHeader SizeOf PickUpMsg + dup allot PickMsgBuf mhMsgLen ! \ The squirrel will scan for an object of a certain type \ \ (I gave up on recursion, let's use the bloody array instead :-) \ \ \ DistSq - Given two object addresses, return the distance btwn them, \ squared. \ \ Structure of a "What are you" message BeginStruct Int wauMsgNum Struct WAUMsg create myMsg SizeOf MsgHeader SizeOf WAUMsg + dup allot myMsg mhMsgLen ! variable lookFor variable foundObject fvariable smallestDist variable theObject \ Return the square of a float : Sq \ [float] n -- n**2 fdup f* ; \ Return the square of the distance between two objects : DistSq \ obj1 obj2 -- | [float] -- distsq dup x@ over x@ f- Sq dup y@ over y@ f- Sq f+ z@ z@ f- Sq f+ ; \ Send the "What are u" message : SendWAUMessage \ -- theObject @ ptr @ myMsg mhDestModuleID ! -1024 myMsg mhMsgBody ! myMsg SendMessage drop ; : ObjectFound? \ -- flag myMsg mhMsgBody @ lookFor @ = ; : SetSmallestDist \ -- theObject @ self @ DistSq \ [float] -- distsq fdup \ [float] -- distsq distsq smallestDist f@ f< \ [float] -- distsq if \ [float] -- distsq smallestDist f! \ [float] -- theObject @ foundObject ! \ [float] -- else \ [float] -- distsq fdrop \ Won't need it \ [float] -- then ; : SetCloserObject SendWAUMessage ObjectFound? if SetSmallestDist then ; : FindObject lookFor ! 1e10 smallestDist f! \ Reset smallestdist to something huuge 0 foundObject ! \ Reset foundObject moduleOrigin myMsg mhSrcModuleID ! localHost myMsg mhDestHostID ! #objects 0 do \ Just print object address for now.... i object theObject ! theObject @ used @ if theObject @ objecttype @ case compoundObject of SetCloserObject endof endcase then loop foundObject @ ; variable msg : rcvr msg ! \ Store the freaki'n adress, we'll bloody need it! :-) msg @ mhMsgBody @ case -1024 of \ The "What Are You" message \ ." Squirrel got the WAU message" objSquirrel msg @ mhMsgBody ! endof dup dup of ." Squirrel received unknown message" . endof endcase ; TheReceiverMemeIs rcvr variable sqhead variable tail variable legs variable arms variable eye1 variable eye2 variable ear1 variable ear2 \ This meme will eventually return the ground level for a given x,z \ coordinate pair. : GroundLevel fdrop fdrop 0e ; : appear begin pause l1 @ ?dup if DestroyObject 0 l1 ! then l2 @ ?dup if DestroyObject 0 l2 ! then appeartask @ sleep pause again ; : blink begin fGetTime time_offset f@ f+ 5e f* fdup fdup 17e fmod fix 0 = 19e fmod fix 0 = 11e fmod fix 0 = or or if eye1 @ 0.5e yscale! eye2 @ 0.5e yscale! pause eye1 @ 0.2e yscale! eye2 @ 0.2e yscale! pause eye1 @ 0.5e yscale! eye2 @ 0.5e yscale! pause eye1 @ 1.0e yscale! eye2 @ 1.0e yscale! then pause again ; \ Walk-related variables fvariable startX fvariable startZ fvariable deltaX fvariable deltaZ fvariable desiredYaw fvariable next_idea variable a_nut variable a_tree \ Walk stops itself if it reaches "a_nut" and tries to avoid "a_tree". \ Walk in a given direction (given in radians) : WalkDirection fdup r>d desiredYaw f! fsincos deltaZ f! deltaX f! self @ x@ startX f! self @ z@ startZ f! fGetTime start_time f! walktask @ dup wake curr_task ! \ See if we're running into any trees! objTree FindObject a_tree ! ; fvariable treX fvariable treZ : walk begin self @ dup yaw@ desiredYaw f@ f+ 2e f/ yaw! sqhead @ dup yaw@ 2e f/ yaw! fGetTime time_offset f@ f+ fdup fdup 26e f* twoPi fmod fdup fsin 0.01e f* 1.0e f+ tail @ xscale! fcos 0.03e f* 1.0e f+ tail @ yscale! 20e f* twoPi fmod fsin 0.01e f* 1.0e f+ squirrel @ yscale! 13e f* twoPi fmod fsin 10e f* fdup fdup legs @ pitch! sqhead @ pitch! 0.01e f* fdup self @ dup y! fGetTime start_time f@ f- 2e f* 0.05e f+ f+ fdup dup deltaX f@ f* startX f@ f+ x! deltaZ f@ f* startZ f@ f+ z! \ Check if we run into a tree a_tree @ if self @ x@ a_tree @ x@ f- fdup treX f! fdup f* self @ z@ a_tree @ z@ f- fdup treZ f! fdup f* f+ fdup \ Are we at the tree now? 9e f< if \ ." Moved away for tree" cr \ Then start away from it! fsqrt 3e fswap f/ fdup treX f@ f* a_tree @ x@ f+ self @ x! treZ f@ f* a_tree @ z@ f+ self @ z! \ treX f@ treZ f@ fatan2 pi f/ 180e f* self @ yaw! else fdrop then then \ Check if we should stop at the nut we're searching! holding_nut @ 0= a_nut @ 0= not and if self @ x@ a_nut @ x@ f- fdup f* self @ z@ a_nut @ z@ f- fdup f* f+ \ Are we at the nut now? 1e f< if \ ." Stopped at nut" cr fGetTime next_idea f! \ Get new idea immediately! then then pause again ; : look begin sqhead @ dup yaw@ desiredYaw f@ f+ 2e f/ yaw! pause again ; : munch begin sqhead @ dup yaw@ 2e f/ yaw! \ Straighten out head fGetTime fdup \ -- time time \ Wiggle head while munching! 20e f* twoPi fmod fdup \ -- time motionparam motionparam 10e f* sqhead @ pitch! \ -- time motionparam -5e f* arms @ pitch! \ -- time holding_nut @ yscale@ \ -- time nutsize fdup 0.2e f> if \ -- time nutsize 0.95e f* holding_nut @ yscale! \ Nuts shrink while munched... else fdrop \ -- time then start_time f@ f- \ -- deltatime 5e f> if \ If squirrel has munched > 5 seconds \ Tasks suspends itself. \ Nut object is destroyed. \ arms and head are put in resting pos. munchtask @ sleep holding_nut @ DestroyObject holding_nut off sqhead @ 0e pitch! arms @ 0e pitch! \ Squirrels grow when they eat :-) self @ xscale@ 0.05e f+ self @ xscale! self @ zscale@ 0.05e f+ self @ zscale! self @ yscale@ 0.03e f+ self @ yscale! \ not so much in height... \ Get new idea immediately! fGetTime next_idea f! then pause again ; : brain begin fGetTime fdup next_idea f@ f> if \ Forget what you were doing! curr_task @ ?dup if sleep 0 curr_task ! then \ This is where the Squirrel gets an idea what to do next! rand 3 and case 0 of \ Hop away randomly 0 a_nut ! \ No nut are being looked for! \ ." Decided to hop away randomly" self @ yaw@ frand 180e f* 90e f- f+ 180e f/ pi f* WalkDirection \ No more ideas for a while!! frand 2e f* 0.5e f+ f+ next_idea f! endof 1 of \ Sit and look \ ." Decided to sit and look" frand 100e f* 50e f- desiredYaw f! looktask @ dup wake curr_task ! \ No more ideas for a while!! frand 1.5e f* 0.2e f+ f+ next_idea f! endof 2 of \ Search for nut, go that way. Pick up if close. \ ." Decided to find, pick up, or eat a nut" cr holding_nut @ if \ ." Had one already - eat it!" cr fdup start_time f! 10e f+ next_idea f! munchtask @ dup wake curr_task ! else \ Default to no more ideas for a random while!! frand 3e f* 0.5e f+ f+ next_idea f! objNut FindObject a_nut ! a_nut @ if \ ." Found a nut!" cr \ How far to the nut? a_nut @ x@ self @ x@ f- fdup deltaX f! fdup f* a_nut @ z@ self @ z@ f- fdup deltaZ f! fdup f* f+ 3e f< if \ If it is close enough... \ ." Picking it up!" cr a_nut @ Orphan drop arms @ a_nut @ Adopts drop a_nut @ 0e x! a_nut @ 0.5e z! a_nut @ -0.15e y! a_nut @ holding_nut ! 1e self @ xscale@ f/ a_nut @ scale else \ ." Walk to it!" cr deltaX f@ deltaZ f@ fatan2 WalkDirection then else \ ." Didn't find a nut!" cr then then endof 3 of fdrop endof endcase else fdrop then pause again ; : go if 1024 #objects - 20 > if \ Calculate the self object (The Compound object I am) moduleOrigin WhichObject self ! ModuleWorld lockedLink plainVisible c" http://www.immersive.com/sq/sq-body.rwx" NewVisible squirrel ! squirrel @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-tail.rwx" NewVisible tail ! squirrel @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-legs.rwx" NewVisible legs ! legs @ dup dup dup dup 0.2e y! 0.1e z! 1.1e xscale! 0.8e yscale! 0.8e zscale! squirrel @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-arms.rwx" NewVisible arms ! arms @ dup 0.7e y! 0.7e z! squirrel @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-head.rwx" NewVisible sqhead ! sqhead @ dup 1.1e y! 0.8e z! sqhead @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-eye.rwx" NewVisible eye1 ! eye1 @ dup dup dup 0.25e y! 0.3e z! 0.18e x! 45e yaw! sqhead @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-eye.rwx" NewVisible eye2 ! eye2 @ dup dup dup 0.25e y! 0.3e z! -0.2e x! -45e yaw! NewMaterial eyeMat ! smoothShaded eyeMat @ MaterialShading 0e 0.6e 1e 3e eyeMat @ MaterialSurface eyeMat @ dup eye1 @ ShapeMaterial eye2 @ ShapeMaterial sqhead @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-ear.rwx" NewVisible ear1 ! ear1 @ dup dup 0.3e y! 0.0e z! 0.2e x! sqhead @ lockedLink plainVisible c" http://www.immersive.com/sq/sq-ear.rwx" NewVisible ear2 ! ear2 @ dup dup 0.3e y! 0.0e z! -0.2e x! ear1 @ 70e yaw! ear2 @ -70e yaw! squirrel @ lockedLink pointLight NewLight l1 ! 5e l1 @ x! 2e l1 @ y! l1 @ 0.9e 0.7e 0.4e LightColor squirrel @ lockedLink pointLight NewLight l2 ! -5e l2 @ x! 2e l2 @ y! l2 @ 0.4e 0.7e 0.2e LightColor \ The behavior tasks. Created sleeping ['] walk NewTask ?dup if walktask ! then ['] look NewTask ?dup if looktask ! then ['] munch NewTask ?dup if munchtask ! then \ The other tasks ['] brain NewTask ?dup if dup braintask ! wake then ['] blink NewTask ?dup if dup blinktask ! wake then ['] appear NewTask ?dup if dup appeartask ! wake then frand 5e f* time_offset f! fGetTime fdup fdup start_time f! end_time f! 2e f+ next_idea f! then else braintask @ ?dup if DestroyTask then blinktask @ ?dup if DestroyTask then walktask @ ?dup if DestroyTask then looktask @ ?dup if DestroyTask then munchtask @ ?dup if DestroyTask then l1 @ ?dup if DestroyObject then l2 @ ?dup if DestroyObject then squirrel @ ?dup if DestroyObject then eyeMat @ ?dup if DestroyMaterial then tail @ ?dup if DestroyObject then legs @ ?dup if DestroyObject then arms @ ?dup if DestroyObject then sqhead @ ?dup if DestroyObject then eye1 @ ?dup if DestroyObject then eye2 @ ?dup if DestroyObject then ear1 @ ?dup if DestroyObject then ear2 @ ?dup if DestroyObject then then ; TheGoMemeIs go ModuleUsed EndModule only main also definitions .( Writing sqr.mm ) ' foo ModuleAddr p" sqr.mm" UnloadModuleToFile forget foo