\ The SQUIRREL WORLD \ Requires: \ Compound object modules: \ sq.mm The squirrel \ tree.mm The tree \ Object files \ floor.rwx The floor \ fern01.rwx Some bush \ 5000 Module: foo only main also std.mlContext! also foo also definitions BeginModule p" objects.mh" "load variable eye variable eyeYaw variable eyePitchRoll variable leye variable lite variable lite2 variable rtask variable mt variable vtx variable y variable squirrel variable tree2 variable floorMat \ :-) variable tex BeginStruct Float pX Float pY Float pZ Struct Points : Point 1 Points ; variable queuetask \ 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 \ Other messages? variable tree variable fern variable floor \ ************************************************************************** \ Slave to time! fvariable LastRenderTime : Elapsed fGetTime LastRenderTime f@ f- ; \ \ \ Navigational stuff \ ************************************************************************** \ First-quadrant normalized mouse routines. Both return -1.0 to 1.0. \ If the distance from the center to the edge of the screen is 1.0, \ this is the distance from the center in which the mouse will not cause \ motion of the vehicle. 0.03e fconstant mouseThreshold : nx \ [float] -- mousex MouseX float WindowWidth float f/ 2e f* 1e f- fdup fabs mouseThreshold f< if fdrop 0e else mouseThreshold fover f0< if f+ else f- then then ; : ny \ [float] -- mousey MouseY float WindowHeight float f/ 2e f* 1e fswap f- fdup fabs mouseThreshold f< if fdrop 0e else mouseThreshold fover f0< if f+ else f- then then ; \ ************************************************************************** \ Task that drives my head around with the mouse fvariable selfX fvariable selfY fvariable selfZ fvariable selfYaw \ Note! In radians! fvariable selfPitch \ Note! In degrees! fvariable cursorX fvariable expCursorX fvariable cursorY \ Storage for the head's pos and angle fvariable expCursorY \ \ Left-button: +-X turns right and left, +-Y moves forward and back \ Right-button: +-X moves nose up and down, +-Y changes elevation : OnlyLeftButton? \ -- flag MouseB leftButton = ; : OnlyRightButton? \ -- flag MouseB rightButton = ; : LButton \ -- The left-button behavior OnlyLeftButton? if nx cursorX f! cursorX f@ 4e fover fabs 2e f* 1e f- f** f* 22e f* Elapsed f* expCursorX f! ny cursorY f! cursorY f@ 4e fover fabs 2e f* 1e f- f** f* 10e f* Elapsed f* expCursorY f! \ x * 4^x expCursorX f@ 0.03e f* selfYaw f+! selfYaw f@ fsincos expCursorY f@ f* fnegate selfZ f+! expCursorY f@ f* selfX f+! selfX f@ eyeYaw @ x! selfZ f@ eyeYaw @ z! selfYaw f@ fnegate r>d eyeYaw @ yaw! then ; : RButton \ -- The right-button behavior OnlyRightButton? if \ Move the nose up and down (change pitch angle) nx 5e f* Elapsed f* selfPitch f@ f+ -60e fmax 30e fmin fdup selfPitch f! eyePitchRoll @ pitch! \ Change the elevation (change the y position) ny 3e f* Elapsed f* selfY f@ f+ 20e fmin 1.5e fmax fdup selfY f! eyeYaw @ y! then ; : DriveLoop \ -- begin pause LButton RButton again ; \ \ \ End navigational stuff : r begin fGetTime LastRenderTime f! render pause again ; variable keyztask : keyz begin key? if key 95 and \ LowerCase it case 70 of world lockedLink plainVisible c" http://www.immersive.com/sq/fern01.rwx" NewVisible ?dup if dup frand 0.5e f- 50e f* x! dup frand 0.5e f- 50e f* z! dup frand 360e f* yaw! frand 0.5e f+ scale then endof 83 of world lockedLink c" http://www.immersive.com/sq/sqr.mm" NewCompound ?dup if dup frand 0.5e f- 60e f* x! dup frand 0.5e f- 60e f* z! dup frand 360e f* yaw! frand 0.4e f* 0.8e f+ scale then endof 84 of 1.6e world lockedLink c" http://www.immersive.com/sq/tree.mm" NewCompound ?dup if dup frand 0.5e f- 70e f* x! dup frand 0.5e f- 70e f* z! dup frand 360e f* yaw! frand 0.5e f* 0.75e f+ scale then endof 27 of bye endof endcase then pause again ; : queue_manager begin fGetTime fdup end_time f@ f> if curr_task @ sleep then \ To be implemented: Get next item in queue... fdrop pause again ; : go if Randomize \ different pattern every time \ \ Define the eyepoint \ world lockedLink NewImaginary eyeYaw ! eyeYaw @ lockedLink NewImaginary eyePitchRoll ! eyePitchRoll @ lockedLink 0 0 WindowWidth WindowHeight NewCamera eye ! 20e fdup eyeYaw @ z! selfZ f! 10e fdup eyeYaw @ y! selfY f! 30e fdup eyeYaw @ x! selfX f! \ selfYaw is in radians. selfPitch is in degrees. 45e fdup eyeYaw @ yaw! d>r fnegate selfYaw f! -10e fdup eyePitchRoll @ pitch! selfPitch f! eye @ 0.3e 0.5e 0.8e SetCameraBackColor \ \ Define the floor \ world lockedLink plainVisible c" http://www.immersive.com/sq/floor.rwx" NewVisible floor ! floor @ 0.25e scale NewMaterial floorMat ! smoothShaded floorMat @ MaterialShading 0.6e 0.4e 0.0e 1e floorMat @ MaterialSurface 0.1e 0.8e 0.1e floorMat @ MaterialColor wireGeometry floorMat @ MaterialGeometry \ c" turf.bmp" NewTexture tex ! \ tex @ floorMat @ MaterialTexture floorMat @ floor @ ShapeMaterial fGetTime LastRenderTime f! ['] keyz NewTask ?dup if dup keyztask ! wake then ['] r NewTask ?dup if dup rtask ! wake then ['] DriveLoop NewTask ?dup if dup mt ! wake then world lockedLink pointLight NewLight lite ! 40e lite @ y! 60e lite @ z! 80e lite @ x! lite @ 0.7e 0.7e 0.7e LightColor world lockedLink pointLight NewLight lite2 ! 20e lite2 @ y! -80e lite2 @ z! -70e lite2 @ x! lite2 @ 0.8e 0.6e 0.6e LightColor world lockedLink c" http://www.immersive.com/sq/sqr.mm" NewCompound squirrel ! world lockedLink plainVisible c" http://www.immersive.com/sq/fern01.rwx" NewVisible fern ! fern @ -20e x! fern @ 50e z! fern @ 4e scale 1.8e world lockedLink c" http://www.immersive.com/sq/tree.mm" NewCompound tree ! tree @ -5e z! 1.5e world lockedLink c" http://www.immersive.com/sq/tree.mm" NewCompound tree2 ! tree2 @ 0.8e scale tree2 @ 16e x! tree2 @ 90e yaw! tree2 @ 5e roll! \ ['] queue_manager NewTask ?dup if dup queuetask ! wake then \ Current running task is walktask. Sleep it in 2.0 seconds \ fGetTime fdup start_time f! 50.0e f+ end_time f! \ walktask @ curr_task ! else queuetask @ ?dup if DestroyTask then rtask @ ?dup if DestroyTask then mt @ ?dup if DestroyTask then keyztask @ ?dup if DestroyTask then squirrel @ DestroyObject tree2 @ DestroyObject floorMat @ DestroyMaterial tex @ DestroyTexture tree @ DestroyObject fern @ DestroyObject floor @ DestroyObject lite @ DestroyObject lite2 @ DestroyObject then ; TheGoMemeIs go ModuleUsed EndModule only main also definitions .( Writing sq.mm ) ' foo ModuleAddr p" sq.mm" UnloadModuleToFile forget foo \ AutoCompile dependent modules... p" tree.m" "load p" nut.m" "load p" sqr.m" "load \ ... and then AutoLoad the module when the source is "compiled"... \ p" sq.mm" "mload \ A handy meme to do it all again.... GOD I'M LAZY :-) \ : a p" sq.m" "load ;