/* WORLDS.P */ section $-worlds => bw_reset bw_objects_file bw_select_bug bw_bug bw_left bw_right bw_move_bug_to bw_grab bw_drop bw_set_brain bw_think bw_update_perceptions bw_update_vision bw_update_smell bw_set_sentence bw_set_reply bw_sentence bw_reply bw_bug_xW bw_bug_yW bw_forwardvector bw_rightvector bw_direction bw_retina bw_display_retina bw_retina_to_list bw_xV, bw_yV bw_smell bw_inventory bw_set_inventory bw_energy bw_set_energy bw_initial_energy bw_rel_forward bw_rel_right bw_world_width bw_world_height ved_world ved_saveworld textfile_to_world textfile_to_worldfile worldfile_to_world; /* SPECIFICATION ------------- This module defines the lowest level of the world/bug simulation used by Eden. For a detailed description of Eden, see HELP EDEN. The idea is that the world is a two-dimensional grid of squares. One or more squares contain bugs. Each square can contain in addition either an object (symbolised by a non-blank character) or no object (symbolised by ` `). You can't have more than one non-bug object in a square. A world is implemented as a record datatype. However, you can treat it as a 2-D array, and subscript it to examine or change objects: w( 3, 4 ) => `+` -> w( 4, 5 ); You can also find out its width and height. Subscripting does not tell you about the bugs. For this, you have various other routines. A world's class_print is set to a line-by-line display routine, so the print-arrow will automatically print the contents: w => The bugs have a position defined by x and y co-ordinates. They also have a direction ("north", "east", "south", or "west"). Both these can be interrogated by appropriate access routines. For convenience in transforming from bug- to world-relative coordinates, you can also get the value of the unit vectors defining a bug's current coordinate system (its righvector and forwardvector). The world's coordinate system is defined as you would expect. Y points upwards ("north"); X points to the right ("east"). The world's origin is (0,0): any attempt to access squares with negative coordinates will cause an error, as will accessing beyond the width and height. A world is usually created by drawing it in Ved. This module contains routines for doing that, and also for saving worlds to file, and restoring them from file. A world can be updated by various routines, which the Eden simulator uses when running. However, it always contains its initial state, and can be reset to this at any time. This initial state defines: the bugs' initial positions; their initial directions; their initial energies; the initial contents of the world, i.e. the object in each square. How objects behave when a bug interacts with them is determined by their definition file - essentially, this maps the character defining the object to a function (Bug action -> behaviour). The current module does not deal with this level of behaviour. Instead, it deals with the world underlying it, by exporting routines such as bw_drop() - make the bug drop what it's holding - and bw_left() - make it turn left. Note that the routine bw_left (for example) _actually_ turns the Bug left, even if the object in its square would not permit this. It is the job of the person writing Eden to ensure that the routines exported from this one are called correctly when implementing objects. This module also defines routines for updating a bug's perceptions so as to match the new state of the world. For efficiency, this updating is not automatically done when the state changes. Instead, you must explicitly force it by calling bw_update_perceptions(). PUBLIC world(xW,yW): (subscripting) Subscripting a world yields a character, denoting the object at that square. If the square is empty, the result is ` `. Subscripting a bug's current square does not yield a `B`, but whatever object is in the square with the bug (` ` if none). Undefined if location (xW,yW) is out of range. PUBLIC c -> world(x,y): (updater by subscripting) A world can be subscripted in update mode. c must be a space or printable character. Undefined if location (xW,yW) does not exist. PUBLIC bw_reset( world ): This resets world and bugs to their initial state. PUBLIC bw_select_bug( n ): This ``selects'' bug number n. All bug-specific routines will affect or interrogate this bug until another one is selected. PUBLIC bw_bug(): Returns the number of the bug currently selected. PUBLIC bw_left( world ): PUBLIC bw_right( world ): Causes the currently selected bug to turn left or right. PUBLIC bw_move_bug_to( world, xW, yW ): Moves the currently selected bug to (xW,yW). Undefined if (xW,yW) is out of range. PUBLIC bw_grab( world ): PUBLIC bw_drop( world ): Causes the currently selected bug to grab the object in its square, or drop the object it's holding. Undefined if (for grab) no object is there; or (for drop) the bug is not holding an object. PUBLIC bw_set_brain( world, p ): Sets the brain of the currently selected bug to be procedure p. p must have no arguments and one result. PUBLIC bw_think( world ): Causes the currently selected bug to "think" by invoking its brain. Returns the bug's action as result. PUBLIC bw_update_perceptions(): Updates the retina and smell of the currently selected bug so as to be consistent with the food's location, and the bug's current surroundings. PUBLIC bw_update_vision(): Updates the retina of the currently selected bug so as to be consistent with its current surroundings. PUBLIC bw_update_smell( world ): Updates the smell perception of the currently selected bug so as to be consistent with the food's current location. PUBLIC bw_set_sentence( world, list ): Sets list to be the sentence that the currently selected bug will process when its brain is next called. PUBLIC bw_set_reply( world, list ): This is called indirectly by the brain to "say" a sentence. PUBLIC bw_sentence( world ): The last sentence the currently selected bug has "heard". PUBLIC bw_reply( world ): The last sentence the currently selected bug has "said". PUBLIC bw_bug_xW( world ): PUBLIC bw_bug_yW( world ): Return the x and y world-coordinates of the currently selected bug. PUBLIC bw_forwardvector( world ): PUBLIC bw_rightvector( world ): Return the forward- or right-vector of the currently selected bug. PUBLIC bw_direction( world ): Returns the direction in which the currently selected bug is facing, as one of "north", "east", "south", "west". PUBLIC bw_retina( world ): Returns the retinal array of the currently selected bug. Note: this is not a copy, but the data structure itself, so you can update it. This is not recommended, and I may prohibit you from doing so in later versions of this software. Also, note that this assumes that only one bug is present. There is as yet no way for one bug to perceive another. PUBLIC bw_display_retina( world ): Displays the retina of the currently selected bug, line by line, tty mode. The bug is shown as a B, obscuring any object thereunder. As above, this routine only works for worlds with one bug. PUBLIC bw_retina_to_list( world, f ): Returns a list corresponding to the retina of the currently selected bug. f must be a procedure of four arguments: f( xB, yB, foodloc, object ). The list is formed by iterating through the bug's retina, visiting every point once (order undefined). For every point where there is an object (i.e. every point where the world is not ` `), f is called, and its result is inserted into the list. xB and yB are the position of the point in the retina, relative to the bug. If the point's position relative to retinal origin= (1,1) is (i,j), then xB=i-xV, and yB=j-yV, where the bug occupies location (xV,yV) in its retina. foodloc is "here" if the bug is carrying the food. Otherwise it is the food's bearing. object is the object. For the point (xB=0,yB=0), i.e. that on which the bug is standing, object is the object (if any) under the bug, not the bug itself. PUBLIC bw_xV( world ): PUBLIC bw_yV( world ): The position of the currently selected bug within its visual array. The left-hand bottom corner of this array is (1,1). Note: this position is set when the bug is created, and does not change as it moves. PUBLIC bw_smell( world ): The bearing ("forward", "back", "right", or "left") of the food in world, as smelt by the currently selected bug. PUBLIC bw_inventory( world ): The inventory of the currently selected bug, i.e. the object it is holding. ` ` if not holding anything. PUBLIC bw_set_inventory( world, char ): Sets the inventory of the currently selected bug to char. PUBLIC bw_energy( world ): The current energy of the currently selected bug. PUBLIC bw_set_energy( world, e ): Sets the currently selected bug's energy to e. Undefined if e is less than zero, or greater than the bug's initial energy. PUBLIC bw_initial_energy( world ): The initial energy that the currently selected bug gets on each incarnation. Note: in the current version, this is the same for all bugs. PUBLIC bw_rel_forward( world, xW, yW, rel ): PUBLIC bw_rel_right( world, xW, yW, rel ): The result of moving rel units along the currently selected bug's forward- or right-vector from (xW,yW) in world. In both cases, the result is two values on the stack: (x coordinate); (y coordinate). PUBLIC bw_world_width( world ): PUBLIC bw_world_height( world ): The width and height of world. Since the world's origin is (0,0), its highest x and y coordinates are width-1 and height-1. PUBLIC bw_objects_file( world ): The name of the world's objects file. PUBLIC ved_world(): Defines the Ved command 'world', which copies the contents of the current buffer into a world. The command can have the following forms world world name These create a new world and assign it to valof(name). If name is omitted, it defaults to "world". Your buffer should start with a header, which is a sequence of blank and/or comment lines. Comments start with a !. It's a good idea to have one comment which specifies the world's name. Following the header, you need a line (uncommented) specifying the objects, initial energy, and initial direction. This has the form F E D where F is the name of a Pop-11 source file (without the .P extension), E is the energy as an integer, and D is one of north, east, west or south. 'saveworld' will assume the first line that isn't blank or a comment to be this specification, and report an error if it has the wrong format. F should name a file containing object definitions. Everything following this line is taken to be the world. 'world' automatically works out its height and width by looking for the leftmost and rightmost occupied columns and the end of the buffer. See HELP EDEN for more details. The world is created with its initial state given by the buffer contents, and reset to that state. PUBLIC ved_saveworld(): Defines the Ved command 'saveworld' which saves the current buffer as a world file in a form readable by worldfile_to_world. The command has the forms saveworld saveworld filename and writes into filename. If filename doesn't have an extension, .W is added. If filename is omitted, the name of the file being edited is used, with an extension of .W added. The buffer must be in the same form as for the 'world' command. PUBLIC worldfile_to_world( filename ): Loads a world from filename (no defaults) and returns it. It does not compile the world's objects file. PUBLIC textfile_to_world( textfile ): This converts a textfile into a world. The file must have the same format as for the Ved 'world' command. PUBLIC textfile_to_worldfile( textfile, worldfile ): As for 'textfile_to_world', but saves the world into worldfile. The worldfile extension defaults to .W. */ /* IMPLEMENTATION -------------- See the individual sections below. */ needs fault; needs vec; needs retina; needs utils; needs add_file_defaults; /* World primitive operations. --------------------------- Records. -------- We define two records, one for a world, and one for its bug. In the first version, I stored the bug's coordinates in the world one rather than the bug one. Though I don't think this is what most people would do, it seemed better model to me: after all, the bug might in some circumstances find itself placed in a space of some other number of dimensions. The number of coordinates would then change, so it can't be an intrinsic property of the bug. However, this is inconvenient for multiple bugs, so I now store coordinates in the bug records. But I still think this is the wrong approach. Comments? In the present implementation, the size of the bug's retina and its position therein are fixed. You can change them by altering the call to new_bug from new_world. Note that we define the class_apply of a world to be a procedure which accesses the elements of its character array. See REF KEYS. Note that the world_chars only contains the background, not the bug. I.e. there is no letter B in it. We use the bug_xW,yW fields to give its location. Portability ----------- The check in the subscripting updater for worlds assumes that characters are represented in ASCII, when checking that object symbols are in range. */ /* Primitives ---------- */ recordclass world world_width, ;;; Wdith. world_height, ;;; Height. world_chars, ;;; Contents, is changed as the simulation runs. world_food_xW, world_food_yW, ;;; Location of food. It is assumed that there's only ;;; one piece of food, and that this is always present ;;; - although it will disappear just before the bug dies. ;;; I need to treat this more cleanly. At present, we ;;; don't check for duplicate food. world_objects_file, ;;; The name of the file where the code for the objects ;;; lives. world_initial_chars, ;;; Initial contents. world_initial_food_xW, world_initial_food_yW, ;;; Initial food locations. world_bugs, ;;; Array of bugs. world_max_bugs, ;;; This array runs from 1..max_bugs. world_selected_bug; ;;; Number of current bug, between 1..max_bugs. recordclass bug bug_retina_width, ;;; Width of retina, whose X index runs from 1..width. bug_retina_height, ;;; Height, whose Y index runs from 1..height. bug_xV, bug_yV, ;;; Position of bug in its retina. Is constant over any one bug. bug_retina, ;;; The retina, datatype 'retina' - see HELP RETINA. Is updated ;;; by bw_update_vision(). bug_smell, ;;; Direction of food, one of "forward", "back", "left", "right", ;;; "here", "carried". Is updated by bw_update_smell(). bug_sentence, ;;; The last sentence ``heard''. A list of characters. bug_reply, ;;; The last reply. A list of items. bug_inventory, ;;; The inventory, as a character. bug_energy, ;;; The energy, between bw_initial_energy and 0. bug_initial_energy, ;;; The initial energy. bug_brain, ;;; The ``think'' procedure. bug_xW, bug_yW, ;;; The bug's coordinates. bug_direction_, ;;; The bug's direction, one of "east", "north", "west", "south". ;;; Use bug_direction() as the access routine: this updates the ;;; direction vectors as well. bug_forwardvector, ;;; Unit vector along bug's Y axis. bug_rightvector, ;;; Unit vector along bug's X axis. bug_initial_xW, bug_initial_yW, bug_initial_direction; ;;; Initial direction and location. vars new_bug;/*forward*/ /* new_world( width, height ): Create a new world running from (0,0) to (width-1,height-1). This world has one bug, with retina size and location as specified. */ define new_world( width, height ); lvars width, height; consworld( width, height, initv(height), undef, undef, undef, initv(height), undef, undef, {% new_bug( 5, 7, 3, 2 ) %}, 1, 1 ); enddefine; /* copy_world( w ): Make a new world which is a copy of w. We have to take care with the character array: if we don't copy each string explicitly, we'll end up sharing the original one in w. The bugs in this world are the same ones as in w, not copies. */ define copy_world( w ) -> the_copy; lvars w, the_copy; lvars j; copy( w ) -> the_copy; initv( w.world_height ) -> the_copy.world_chars; for j to w.world_height do copy((w.world_chars)(j)) -> (the_copy.world_chars)(j); endfor; initv( w.world_height ) -> the_copy.world_initial_chars; for j to w.world_height do copy((w.world_initial_chars)(j)) -> (the_copy.world_initial_chars)(j); endfor; enddefine; /* World-subscripting. */ procedure( xW, yW, world ); lvars xW, yW, world; (world.world_chars)( yW+1 )( xW+1 ); endprocedure -> class_apply( key_of_dataword("world") ); vars bw_bug;/*forward*/ /* Updater for world-subscripting. */ procedure( c, xW, yW, world ); lvars c, xW, yW, world; if c < ` ` or c > 127 then FAULT( 'updating world: character out of range', [%c,xW,yW,world%] ); endif; c -> (world.world_chars)( yW+1 )( xW+1 ); if c = `+` then world.bw_bug.bug_xW -> world.world_food_xW; world.bw_bug.bug_yW -> world.world_food_yW; endif; endprocedure -> updater( class_apply( key_of_dataword("world") ) ); /* new_bug( retina_width, retina_height, xV, yV ): Create a new bug with specified width and height of retina, and location in it. */ define new_bug( rw, rh, xV, yV ); lvars rw, rh, xV, yV; consbug( rw, rh, xV, yV, new_retina(rw,rh), undef, [], [], undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef ); enddefine; define bw_select_bug( world, n ); lvars world, n; if n < 1 or n > world.world_max_bugs then FAULT( 'bw_select_bug: n out of range', [%world,n%] ); endif; n -> world.world_selected_bug; enddefine; define bw_bug( world ); lvars world; (world.world_bugs)( world.world_selected_bug ); enddefine; define global bw_objects_file( world ); lvars world; world.world_objects_file; enddefine; /* Maintaining direction vectors. ------------------------------ We ensure that the bug_direction field of a bug, if updated, automatically changes the bug's forward and rightvector. Maintaining these was Simon's idea; it's a nice trick for converting from bug to world coordinates. */ define bug_direction( bug ); lvars bug; bug.bug_direction_; enddefine; define updaterof bug_direction( dir, bug ); lvars dir, bug; dir -> bug.bug_direction_; switchon dir case = "north" then consvec( 0, 1 ) -> bug.bug_forwardvector; consvec( 1, 0 ) -> bug.bug_rightvector; case = "east" then consvec( 1, 0 ) -> bug.bug_forwardvector; consvec( 0, -1 ) -> bug.bug_rightvector; case = "south" then consvec( 0, -1 ) -> bug.bug_forwardvector; consvec( -1, 0 ) -> bug.bug_rightvector; case = "west" then consvec( -1, 0 ) -> bug.bug_forwardvector; consvec( 0, 1 ) -> bug.bug_rightvector; else FAULT( 'bug_direction: bad direction', [%dir, bug%] ); endswitchon enddefine; /* Resetting the world. -------------------- We copy the initial state into the working state. */ define global bw_reset( world ); lvars world; lvars i, j; lvars bug; for i to world.world_max_bugs do bw_select_bug( world, i ); bw_bug( world ) -> bug; bug.bug_initial_energy -> bug.bug_energy; bug.bug_initial_direction -> bug.bug_direction; ` ` -> bug.bug_inventory; bug.bug_initial_xW -> bug.bug_xW; bug.bug_initial_yW -> bug.bug_yW; endfor; world.world_initial_food_xW -> world.world_food_xW; world.world_initial_food_yW -> world.world_food_yW; for j to world.world_height do copy((world.world_initial_chars)(j)) -> (world.world_chars)(j); endfor; enddefine; /* Movement primitives. -------------------- */ define global bw_left( world ); lvars world; lvars bug = world.bw_bug; switchon bug.bug_direction case = "north" then "west" case = "west" then "south" case = "south" then "east" case = "east" then "north" endswitchon -> bug.bug_direction enddefine; define global bw_right( world ); lvars world; lvars bug = world.bw_bug; switchon bug.bug_direction case = "north" then "east" case = "west" then "north" case = "south" then "west" case = "east" then "south" endswitchon -> bug.bug_direction enddefine; define global bw_move_bug_to( world, xW, yW ); lvars world, xW, yW; lvars bug = world.bw_bug; if xW < 0 or xW > world.world_width-1 then FAULT( 'bw_move_bug_to: xW out of range', [%world,xW,yW%] ) endif; if yW < 0 or yW > world.world_height-1 then FAULT( 'bw_move_bug_to: yW out of range', [%world,xW,yW%] ) endif; xW -> bug.bug_xW; yW -> bug.bug_yW; enddefine; /* Dropping and grasping. ---------------------- */ define global bw_grab( world ); lvars world; lvars bug = world.bw_bug, obj; world( bug.bug_xW, bug.bug_yW ) -> obj; if obj = ` ` then FAULT( 'bw_grab: trying to grab a space', [%world%] ) endif; obj -> bug.bug_inventory; ` ` -> world( bug.bug_xW, bug.bug_yW ); enddefine; define global bw_drop( world ); lvars world; lvars bug = world.bw_bug; lvars dropped; bug.bug_inventory ->> world( bug.bug_xW, bug.bug_yW ) -> dropped; if dropped = `+` then bug.bug_xW -> world.world_food_xW; bug.bug_yW -> world.world_food_yW; elseif dropped = ` ` then FAULT( 'bw_drop: not holding an object' ) endif; ` ` -> bug.bug_inventory; enddefine; /* Thinking. --------- */ define global bw_set_brain( world, brain ); lvars world, brain; lvars bug = world.bw_bug; brain -> bug.bug_brain; enddefine; define global bw_think( world ); lvars world; lvars bug = world.bw_bug; (bug.bug_brain)(); enddefine; /* Updating perceptions. --------------------- */ vars bw_update_smell, bw_update_vision; /*forward*/ define global bw_update_perceptions( world ); lvars world; bw_update_smell( world ); bw_update_vision( world ); enddefine; vars bearing;/*forward*/ define global bw_update_smell( world ); lvars world; lvars bug = world.bw_bug; if bug.bug_inventory = `+` then "carried" elseif bug.bug_xW = world.world_food_xW and bug.bug_yW = world.world_food_yW then "here" else bearing( world, world.world_food_xW, world.world_food_yW ); endif -> bug.bug_smell; enddefine; /* bearing( world, xW, yW ): Returns the bearing of (xW,yW) relative to the bug in world. */ define bearing( world, xW, yW ); lvars xW, yW; lvars xdiff,ydiff,forwarddiff,rightdiff; lvars bug = world.bw_bug; lvars forwardvector=bug.bug_forwardvector, rightvector=bug.bug_rightvector; xW-bug.bug_xW -> xdiff; yW-bug.bug_yW -> ydiff; if xdiff=0 and ydiff=0 then bug( 'bearing: xdiff=ydiff=0' ) endif; forwardvector.vec_x*xdiff+forwardvector.vec_y*ydiff -> forwarddiff; rightvector.vec_x*xdiff+rightvector.vec_y*ydiff -> rightdiff; if abs(rightdiff)>abs(forwarddiff) then if rightdiff>0 then "right" else "left" endif; else if forwarddiff>0 then "forward" else "back" endif; endif; enddefine; /* B_to_W( world, xB, yB ): Returns the co-ordinates in the world system of a point expressed in the bug's system. */ define B_to_W( world, xB, yB ); lvars world, xB, yB; lvars xW, yW; lvars bug = world.bw_bug; lvars forwardvector=bug.bug_forwardvector, rightvector=bug.bug_rightvector, bugxW = bug.bug_xW, bugyW = bug.bug_yW; bugxW + forwardvector.vec_x*yB + rightvector.vec_x*xB -> xW; bugyW + forwardvector.vec_y*yB + rightvector.vec_y*xB -> yW; xW; yW; enddefine; vars edgecheck;/*forward*/ define global bw_update_vision( world ); lvars world; lvars xW, yW, i, j; lvars bug = world.bw_bug; lvars forwardvector=bug.bug_forwardvector, rightvector=bug.bug_rightvector; lvars xV = bug.bug_xV, yV = bug.bug_yV; for i to bug.bug_retina_width do for j to bug.bug_retina_height do B_to_W( world, i-xV, j-yV ) -> yW -> xW; if edgecheck( world, xW, yW ) then world( xW, yW ) else ` ` endif -> (bug.bug_retina)(i,j); endfor; endfor; enddefine; /* edgecheck( world, xW, yW ): Returns true if xW,yW are within world, false otherwise. */ define edgecheck( world, xW, yW ); lvars world, xW, yW; xW>=0 and xW<=world.world_width-1 and yW>=0 and yW<=world.world_height-1; enddefine; define global bw_set_sentence( world, list ); lvars world, list; lvars bug = world.bw_bug; list -> bug.bug_sentence; enddefine; define global bw_set_reply( world, list ); lvars world, list; lvars bug = world.bw_bug; list -> bug.bug_reply; enddefine; /* Bug state access. ----------------- */ define global bw_bug_xW( world ); lvars world; lvars bug = world.bw_bug; bug.bug_xW; enddefine; define global bw_bug_yW( world ); lvars world; lvars bug = world.bw_bug; bug.bug_yW; enddefine; define global bw_forwardvector( world ); lvars world; lvars bug = world.bw_bug; bug.bug_forwardvector; enddefine; define global bw_rightvector( world ); lvars world; lvars bug = world.bw_bug; bug.bug_rightvector; enddefine; define global bw_direction( world ); lvars world; lvars bug = world.bw_bug; bug.bug_direction; enddefine; define global bw_retina( world ); lvars world; lvars bug = world.bw_bug; bug.bug_retina; enddefine; define global bw_display_retina( world ); lvars world; lvars bug = world.bw_bug; lvars i, j; for j from bug.bug_retina_height by -1 to 1 do for i to bug.bug_retina_width do if i=bug.bug_xV and j=bug.bug_yV then cucharout( `B` ) else cucharout( (bug.bug_retina)(i,j) ); endif; endfor; 1.nl; endfor; 1.nl; enddefine; define global bw_retina_to_list( world, f ); lvars world, f; lvars i, j; lvars bug = world.bw_bug; lvars xV=bug.bug_xV, yV=bug.bug_yV; [% for i to bug.bug_retina_width do for j to bug.bug_retina_height do f( i-xV, j-yV, if i=xV and j=yV then "here" else bearing(world,B_to_W(world,i-xV,j-yV)) endif, (bug.bug_retina)(i,j) ); endfor; endfor; %] enddefine; define global bw_xV( world ); lvars world; lvars bug = world.bw_bug; bug.bug_xV; enddefine; define global bw_yV( world ); lvars world; lvars bug = world.bw_bug; bug.bug_yV; enddefine; define global bw_smell( world ); lvars world; lvars bug = world.bw_bug; bug.bug_smell; enddefine; define global bw_sentence( world ); lvars world; lvars bug = world.bw_bug; bug.bug_sentence; enddefine; define global bw_reply( world ); lvars world; lvars bug = world.bw_bug; bug.bug_reply; enddefine; define global bw_inventory( world ); lvars world; lvars bug = world.bw_bug; bug.bug_inventory; enddefine; define global bw_set_inventory( world, char ); lvars world, char; lvars bug = world.bw_bug; char -> bug.bug_inventory; enddefine; define global bw_energy( world ); lvars world; lvars bug = world.bw_bug; bug.bug_energy; enddefine; define global bw_set_energy( world, e ); lvars world, e; lvars bug = world.bw_bug; ;;; if e < 0 or e > bug.bug_initial_energy then ;;; It's sometimes useful to have more energy than the original ;;; amount. if e < 0 then FAULT( 'bw_set_energy: energy out of range', [%world,e%] ) endif; e -> bug.bug_energy; enddefine; define global bw_initial_energy( world ); lvars world; lvars bug = world.bw_bug; bug.bug_initial_energy; enddefine; define global bw_rel_forward( world, xW, yW, rel ); lvars world, xW, yW, rel; lvars bug = world.bw_bug; xW + (bug.bug_forwardvector.vec_x)*rel; yW + (bug.bug_forwardvector.vec_y)*rel; enddefine; define global bw_rel_right( world, xW, yW, rel ); lvars world, xW, yW, rel; lvars bug = world.bw_bug; xW + (bug.bug_rightvector.vec_x)*rel; yW + (bug.bug_rightvector.vec_y)*rel; enddefine; /* World state access. ------------------- */ define global bw_world_width( world ); lvars world; world.world_width; enddefine; define global bw_world_height( world ); lvars world; world.world_height; enddefine; /* Creating worlds in Ved. ----------------------- */ vars fit; /*forward*/ vars locate_in_world;/*forward*/ /* vedworld(): Scans the current Ved buffer and if no errors are detected, returns a world record for it. It works by looking for the bounds of the buffer, skipping header lines, reading and checking the specification line, and copying everything below it into the world's character array. It also checks for the presence of the Bug and food, and works out their coordinates. At the moment, it works for worlds with one bug only. */ define vedworld() -> result; lvars result; lvars i, yVED_min, yVED_max, xVED_min, xVED_max; lvars first_non_blank; lvars bug_xW, bug_yW, food_xW, food_yW; lvars objects_file, energy, direction; /* Find first non-blank line. */ 1 -> i; while ( vedjumpto(i,1); vedtrimline(); vvedlinesize = 0 or starts_with(vedthisline(), `!` ) ) do 1 + i -> i; endwhile; i -> first_non_blank; /* Get name of objects file, energy, direction. */ vedjumpto( first_non_blank, 1 ); vedmoveitem() -> objects_file; vedmoveitem() -> energy; vedmoveitem() -> direction; if vedline /= first_non_blank then vederror( 'Missing objects-file, energy, or direction' ); endif; if not(objects_file.isword) then vederror( 'Objects-filename not a name' ); endif; if not(energy.isinteger) then vederror( 'Energy not an integer' ); endif; if not(direction.isword) then vederror( 'Direction not a name' ); endif; objects_file >< '.p' -> objects_file; /* Get top line of world. */ first_non_blank + 1 -> yVED_min; /* Get bottom line of world. */ vvedbuffersize -> i; while ( vedjumpto(i,1); vedtrimline(); vvedlinesize = 0 ) do i - 1 -> i; endwhile; i -> yVED_max; /* Find first and last column. */ 999 -> xVED_min; 1 -> xVED_max; for i from yVED_min to yVED_max do vedjumpto(i,1); vedtrimline(); min( xVED_min, first_non_space_pos(vedthisline()) ) -> xVED_min; max( xVED_max, last_non_space_pos(vedthisline()) ) -> xVED_max; endfor; new_world( xVED_max-xVED_min+1, yVED_max-yVED_min+1 ) -> result; /* Copy world from buffer. */ for i from yVED_min to yVED_max do vedjumpto(i,1); vedtrimline(); fit( vedthisline(), xVED_min, xVED_max ) -> (result.world_initial_chars)(yVED_max-i+1); endfor; /* Locate bug. */ if ( locate_in_world( result.world_initial_chars, `B` ) ->> bug_yW ) = false then vederror( 'No bug in world' ) else () -> bug_xW; ` ` -> (result.world_initial_chars)( bug_yW+1 )( bug_xW+1 ); /* We don't actually keep the bug in the picture. */ endif; /* Locate food. */ if ( locate_in_world( result.world_initial_chars, `+` ) ->> food_yW ) = false then vederror( 'No food in world' ) else () -> food_xW; endif; bw_select_bug( result, 1 ); bug_xW -> result.bw_bug.bug_initial_xW; bug_yW -> result.bw_bug.bug_initial_yW; food_xW -> result.world_initial_food_xW; food_yW -> result.world_initial_food_yW; objects_file -> result.world_objects_file; direction -> result.bw_bug.bug_initial_direction; energy -> result.bw_bug.bug_initial_energy; result.bw_reset; enddefine; /* vedmakeworld( proc ): Reads world from the current Ved buffer, converts it to a world record w, and calls proc( w, name ) where name is the argument given to the Ved command. When using Pop-11, proc just assigns w to valof(name). However, we might want to use 'vedsetworld' in other contexts. See comment in RETINA.P under vedretina. */ define vedmakeworld( proc ); lvars proc; lvars varname, world, args, len; if vedargument = '' then "world" -> varname; else getvedargs( [1] ) -> args -> len; if len = 1 then args(1).consword -> varname; endif; endif; vedworld() -> world; proc( world, varname ); enddefine; define global ved_world(); vedmakeworld( procedure(world,varname); lvars world,varname; world -> valof(varname) endprocedure ); enddefine; /* Saving worlds to file. ---------------------- */ define ved_saveworld(); lvars the_world, file; if vedargument = '' then sysfilename(vedcurrent) else vedargument endif -> file; add_file_defaults( '', file, '.w' ) -> file; vedputmessage( 'Copying world' ); vedworld() -> the_world; vedputmessage( 'Saving world' ); the_world -> datafile( file><'' ); vedputmessage( 'World saved in '> the_world; add_file_defaults( '', worldfile, '.w' ) -> worldfile; pr( 'Saving world\n' ); the_world -> datafile( worldfile ); pr( 'World saved in '><'\n' ); enddefine; define global worldfile_to_world( wf ); lvars wf; datafile( wf ) enddefine; /* String operations for world-building. ------------------------------------- We use these when searching Ved buffers, looking for the bug, and so on. */ /* locate_in_world( chars, c ): Returns the world coordinates of character c in chars (a world's character array. If there's more than one occurrence, which one it finds is undefined. If c not found, returns false. */ define locate_in_world( chars, c ); lvars chars, c; lvars i, m; for i to chars.datalength do if ( locchar( c, 1, chars(i) ) ->> m ) /= false then return( m-1, i-1 ); endif; endfor; false; enddefine; /* fit( s, low, high ): That substring of s which begins at low, and extends to high. If s is not that long, the result is padded with spaces. Not world-specific at all: could be put in a general-purpose library. */ define fit( s, low, high ); lvars s, low, high; lvars i, len=datalength(s); for i from low to high do if i > len then ` ` else s(i) endif; endfor; consstring( high-low+1 ); enddefine; endsection;