/* WORLDS.P */ section $-worlds => bw_reset define_object trace_objects untrace_objects bw_object_name bw_objects_file bw_new_object bw_place_object bw_move_object bw_destroy_object bw_set_display_routines bw_new_bug bw_initialise_bug bw_set_retina_size bw_resume_bug exec bw_select_bug bw_current_bug bw_act bw_left bw_right bw_forward bw_back bw_move_bug_to bw_grab bw_drop bw_update_vision bw_say bw_user_say bw_clear_sentences bw_heard_from bw_heard_by_user_from bw_bug_xW bw_bug_yW bw_forwardvector bw_rightvector bw_direction bw_retina bw_display_retina bw_retina_to_list bw_bearing bw_xV, bw_yV bw_inventory bw_rel_forward bw_rel_right bw_kill_bug bw_bug_is_dead bw_world_width bw_world_height ved_world ved_saveworld textfile_to_world textfile_to_worldfile worldfile_to_world define_action; /* 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. 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 bw_reset( world ): This resets world and bugs to their initial state. PUBLIC bw_select_bug( world, n ): This ``selects'' bug number n. All bug-specific routines will affect or interrogate this bug until another one is selected. PUBLIC current_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_new_bug( world, id, p ): Creates a new bug with id, and sets its brain to be a process made from procedure p. Leaves this bug selected in world. PUBLIC bw_resume_bug( world ): Causes the currently selected bug to "think" by invoking its brain. This runs the bug until it obeys a call of -exec-, whose argument will be returned as the result. PUBLIC bw_update_vision(): Updates the retina of the currently selected bug so as to be consistent with its current surroundings. PUBLIC bw_user_say( world, other, list ): Called by the user to "say" a sentence to -other-. PUBLIC bw_say( world, other, list ): This is called by the currently selected bug to "say" a sentence to -other-. -other- can be "user" or a bug id. PUBLIC bw_heard_from( world, other ): The last thing the currently selected bug has "heard" from -other-. PUBLIC bw_heard_by_user_from( world, other ): The last thing the user has "heard" from -other-. 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 three arguments: f( xB, yB, 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. 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_inventory( world ): The inventory of the currently selected bug, i.e. the object it is holding. ` ` if not holding anything. 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 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. 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; needs smatch; /* 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_contents 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_user_heards, ;;; Replies directed from bugs to user. world_buglist, ;;; List of bug data created when saving world. world_objects, ;;; Object procedures. world_objects_file, ;;; Object file. world_ved_move_bug_to, world_ved_place_object_at, ;;; Display routines. world_width, ;;; Wdith. world_height, ;;; Height. world_contents, ;;; Contents, is changed as the simulation runs. world_initial_chars, ;;; Initial contents. world_retina_width, world_retina_height, world_xV, world_yV ;;; Retina size and position 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_heards, ;;; The sentences heard. A list of the form ;;; [ from_id list from_id list ... ] bug_inventory, ;;; The inventory, as a character. bug_brain, bug_process, ;;; The ``think'' procedure, and the process made therefrom. bug_is_dead ;;; True if it is. 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. /* Actions ------- */ vars actions; [] -> actions; define global define_action( name ); lvars name; if not(member(name,actions)) then name :: actions -> actions; endif; enddefine; /* Objects ------- */ vars char_to_name, char_to_proc, id_to_char; vars tracing_objects = false; define global trace_objects(); true -> tracing_objects; enddefine; define global untrace_objects(); false -> tracing_objects; enddefine; define global define_object(); lvars name, proc, char, attrs; lvars attr; if ().dup.islist then () -> attrs; () -> char; () -> proc; () -> name else [] -> attrs; () -> char; () -> proc; () -> name endif; procedure (action,id,xW,yW,proc,name,char); lvars proc, name, char, id, xW, yW; if tracing_objects then printf('About to call object %p (%p) with action=%p, id=%p, (xW,yW)=(%p,%p)\n', [%name,char,action,id,xW,yW%] ) endif; proc(action,id,xW,yW); if tracing_objects then printf('Returned from object %p\n', [%name%] ); endif; endprocedure(%proc,name,char%) -> proc; if char_to_proc.isundef then newproperty( [], 30, undef, true ) -> char_to_proc; newproperty( [], 30, undef, true ) -> char_to_name; endif; proc -> char_to_proc(char); name -> char_to_name(char); for attr in attrs do newproperty( [], 10, undef, true ) -> valof(attr); endfor; enddefine; define global bw_act( world, action ); lvars world, action; lvars xW=bw_bug_xW(world), yW=bw_bug_yW(world); lvars id; if action = [forward] then bw_rel_forward(world,xW,yW,1) -> yW -> xW; (world.world_contents)(xW,yW) -> id; elseif action = [back] then bw_rel_forward(world,xW,yW,-1) -> yW -> xW; (world.world_contents)(xW,yW) -> id; elseif action = [drop] then world.current_bug.bug_inventory -> id; elseif action = [use] then if bw_inventory(world) = ` ` then (world.world_contents)(xW,yW) -> id; else world.current_bug.bug_inventory -> id; endif else (world.world_contents)(xW,yW) -> id; endif; message( action, id, xW, yW ) enddefine; define message( action, id, xW, yW ); lvars action, id, xW, yW; id_to_proc(id)(action,id,xW,yW); enddefine; define id_to_proc(id); lvars id; char_to_proc(id_to_char(id)) enddefine; vars instance_count, id_to_char, id_to_location; define global bw_new_object( world, name_or_char ) -> id; lvars world, name_or_char, id; lvars char; 1 + instance_count -> instance_count; instance_count -> id; if name_or_char.isword then name_to_char(name_or_char) -> char; else name_or_char -> char; endif; char -> id_to_char(instance_count); message( [new], id, undef, undef ); enddefine; vars display_object_changes; define global bw_place_object( world, id, loc ); lvars world, id, loc; lvars bug = world.current_bug; loc -> id_to_location(id); if loc = "inventory" then id -> bug.bug_inventory else id -> (world.world_contents)(loc(1),loc(2)); unless loc(1) = bug.bug_xW and loc(2) = bug.bug_yW then if display_object_changes then world_ved_place_object_at( world )( id.id_to_char, loc(1), loc(2) ); endif; endunless; endif; enddefine; define global bw_move_object( world, id, loc ); lvars world, id, loc; lvars oldloc; id_to_location(id) -> oldloc; bw_place_object( world, bw_new_object( world, ` ` ), oldloc ); bw_place_object( world, id, loc ); enddefine; define global bw_destroy_object( world, id_or_loc ); lvars world, id_or_loc; lvars loc, id; if id_or_loc.islist then id_or_loc -> loc; (world.world_contents)(loc(1),loc(2)) -> id; else id_to_location(id_or_loc) -> loc; id_or_loc -> id; endif; bw_place_object( world, bw_new_object(world,` `), loc ); undef ->> id_to_location(id) -> id_to_char(id); enddefine; define global bw_objects_file( world ); lvars world; world.world_objects_file; enddefine; define global bw_object_name(world,char); lvars world, char; char_to_name(char); enddefine; /* Basic world access ------------------ */ 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; lvars world; consworld( explode(initv(datalength(key_of_dataword("world")))) ) -> world; [] -> world_buglist(world); width -> world_width(world); height -> world_height(world); newanyarray( [% 0, width-1, 0, height-1 %], ` `, key_of_dataword("string") ) -> world_initial_chars(world); newarray( [% 0, width-1, 0, height-1 %] ) -> world_contents(world); [] -> world_bugs(world); 0 -> world_selected_bug(world); 0 -> world_max_bugs(world); [] -> world_user_heards(world); world; 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; copy(world_initial_chars(world)) -> world_initial_chars(the_copy); copy(world_contents(world)) -> world_contents(the_copy); enddefine; /* World-subscripting. */ procedure( xW, yW, world ); lvars xW, yW, world; (world.world_contents)( xW, yW ).id_to_char; endprocedure -> class_apply( key_of_dataword("world") ); vars current_bug;/*forward*/ /* */ define global bw_new_bug( world, id, proc ); lvars world, id, proc; lvars bug; consbug( explode(initv(datalength(key_of_dataword("bug")))) ) -> bug; world.world_retina_width -> bug_retina_width(bug); world.world_retina_height -> bug_retina_height(bug); world.world_xV -> bug_xV(bug); world.world_yV -> bug_yV(bug); new_retina(world.world_retina_width,world.world_retina_height) -> bug_retina(bug); [] -> bug_heards(bug); proc -> bug_brain(bug); printf('Setting dead\n',[]); false -> bug_is_dead(bug); printf('Bug %p\n',[%bug%]); if id > world.world_max_bugs then expand( world.world_bugs, id ) -> world.world_bugs; id -> world.world_max_bugs; endif; bug -> (world.world_bugs)(id); id -> world.world_selected_bug; enddefine; define global bw_initialise_bug( world, direction ); lvars world, direction; lvars buginfo, xW, yW, bug = world.current_bug; lvars buglist = world.world_buglist, index; min( length(buglist), world.bw_current_bug ) -> index; buglist(index) -> buginfo; buginfo(1) -> xW; buginfo(2) -> yW; xW -> bug.bug_initial_xW; yW -> bug.bug_initial_yW; direction -> bug.bug_initial_direction; enddefine; define global 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 global bw_current_bug( world ); lvars world; world.world_selected_bug; enddefine; define current_bug( world ); lvars world; (world.world_bugs)( world.world_selected_bug ); enddefine; define global bw_set_retina_size( world, rw, rh, xV, yV ); lvars rw, rh, xV, yV; rw -> world_retina_width(world); rh -> world_retina_height(world); xV -> world_xV(world); yV -> world_yV(world); 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. */ vars message;/*forward*/ define global bw_reset( world ); lvars world; lvars i, j; lvars bug, id; for i to world.world_max_bugs do bw_select_bug( world, i ); current_bug( world ) -> bug; bug.bug_initial_direction -> bug.bug_direction; bug.bug_initial_xW -> bug.bug_xW; bug.bug_initial_yW -> bug.bug_yW; [] -> bug.bug_heards; consproc(0,bug.bug_brain) -> bug.bug_process; endfor; 0 -> instance_count; newproperty( [], 100, undef, true ) -> id_to_char; newproperty( [], 100, undef, true ) -> id_to_location; false -> display_object_changes; for i from 0 to world.world_width-1 do for j from 0 to world.world_height-1 do bw_new_object( world, (world.world_initial_chars)(i,j) ) -> id; bw_place_object( world, id, [%i,j%] ); endfor; endfor; bw_place_object( world, bw_new_object(world,` `), "inventory" ); [] -> world_user_heards(world); true -> display_object_changes; enddefine; /* Display interface ----------------- */ define global bw_set_display_routines( world, move_bug, place_object ); lvars world, move_bug, place_object; move_bug -> world.world_ved_move_bug_to; place_object -> world.world_ved_place_object_at; enddefine; /* Movement primitives. -------------------- */ define global bw_left( world ); lvars world; lvars bug = world.current_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.current_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.current_bug; lvars old_xW = bug.bug_xW, old_yW = bug.bug_yW; 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; world_ved_move_bug_to( world )( old_xW, old_yW ); enddefine; define global bw_forward( world ); lvars world; lvars bug = world.current_bug; bw_move_bug_to( world, bw_rel_forward(world,bug.bug_xW,bug.bug_yW,1) ); enddefine; define global bw_back( world ); lvars world; lvars bug = world.current_bug; bw_move_bug_to( world, bw_rel_forward(world,bug.bug_xW,bug.bug_yW,-1) ); enddefine; /* Dropping and grasping. ---------------------- */ define global bw_grab( world ); lvars world; lvars bug = world.current_bug, id; (world.world_contents)( bug.bug_xW, bug.bug_yW ) -> id; if bug.bug_inventory.id_to_char = ` ` then bw_move_object( world, id, "inventory" ); ;;; Don't draw the object, as it would overwrite the bug. endif; enddefine; define global bw_drop( world ); lvars world; lvars bug = world.current_bug; lvars id = bug.bug_inventory; if world(bug.bug_xW, bug.bug_yW) = ` ` then bw_move_object( world, id, [%bug.bug_xW, bug.bug_yW%] ); endif; enddefine; /* Thinking. --------- */ define global bw_resume_bug( world ); lvars world; runproc( 0, world.current_bug.bug_process ); enddefine; define global exec(action); suspend( action, 1 ); enddefine; /* Updating perceptions. --------------------- */ /* bw_bearing( world, xW, yW ): Returns the bearing of (xW,yW) relative to the bug in world. */ define global bw_bearing( world, xW, yW ); lvars xW, yW; lvars xdiff,ydiff,forwarddiff,rightdiff; lvars bug = world.current_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 FAULT( 'bw_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.current_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.current_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_say( world, other_id, list ); lvars world, other_id, list; lvars bug_id = world.bw_current_bug; put_sentence( world, bug_id, other_id, list ); enddefine; define global bw_user_say( world, other_id, list ); lvars world, other_id, list; put_sentence( world, "user", other_id, list ); enddefine; define put_sentence( world, from_id, to_id, list ); lvars world, from_id, to_id, list; lvars to_s; vars pre, post; if to_id = "user" then world.world_user_heards else ((world.world_bugs)(to_id)).bug_heards endif -> to_s; if to_s matches [ ?? ^ !pre ^from_id = ?? ^ !post ] then [ ^^pre ^from_id ^list ^^post ] else [ ^from_id ^list ^^(to_s) ] endif -> to_s; if to_id = "user" then to_s -> world.world_user_heards else to_s -> ((world.world_bugs)(to_id)).bug_heards endif; enddefine; define global bw_clear_sentences( world ); lvars world; lvars i; [] -> world.world_user_heards; for i to world.world_max_bugs do [] -> ((world.world_bugs)(i)).bug_heards; endfor; enddefine; /* Bug state access. ----------------- */ define global bw_bug_xW( world ); lvars world; lvars bug = world.current_bug; bug.bug_xW; enddefine; define global bw_bug_yW( world ); lvars world; lvars bug = world.current_bug; bug.bug_yW; enddefine; define global bw_forwardvector( world ); lvars world; lvars bug = world.current_bug; bug.bug_forwardvector; enddefine; define global bw_rightvector( world ); lvars world; lvars bug = world.current_bug; bug.bug_rightvector; enddefine; define global bw_direction( world ); lvars world; lvars bug = world.current_bug; bug.bug_direction; enddefine; define global bw_retina( world ); lvars world; lvars bug = world.current_bug; bug.bug_retina; enddefine; define global bw_display_retina( world ); lvars world; lvars bug = world.current_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.current_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, (bug.bug_retina)(i,j) ); endfor; endfor; %] enddefine; define global bw_xV( world ); lvars world; lvars bug = world.current_bug; bug.bug_xV; enddefine; define global bw_yV( world ); lvars world; lvars bug = world.current_bug; bug.bug_yV; enddefine; define global bw_heard_from( world, id ); lvars world; lvars bug = world.current_bug; lvars heards = bug.bug_heards; vars sentence; if heards matches [ == ^id ? ^ !sentence == ] then sentence else [] endif; enddefine; define global bw_heard_by_user_from( world, id ); lvars world; lvars bug = world.current_bug; vars sentence; if world.world_user_heards matches [ == ^id ? ^ !sentence ] then sentence else [] endif; enddefine; define global bw_inventory( world ); lvars world; lvars bug = world.current_bug; bug.bug_inventory.id_to_char; enddefine; define global bw_rel_forward( world, xW, yW, rel ); lvars world, xW, yW, rel; lvars bug = world.current_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.current_bug; xW + (bug.bug_rightvector.vec_x)*rel; yW + (bug.bug_rightvector.vec_y)*rel; enddefine; define global bw_kill_bug( world ); lvars world; lvars bug = world.current_bug; true -> bug_is_dead(bug); enddefine; define global bw_bug_is_dead( world ); lvars world; lvars bug = world.current_bug; bug_is_dead(bug); 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, j, yVED_min, yVED_max, xVED_min, xVED_max; lvars first_non_blank; lvars bug_xW, bug_yW, food_xW, food_yW; lvars objects_file; lvars line, c, bug_id; /* 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. */ vedjumpto( first_non_blank, 1 ); vedmoveitem() -> objects_file; if vedline /= first_non_blank then vederror( 'Missing objects-file' ); endif; if not(objects_file.isword) then vederror( 'Objects-filename 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 j from yVED_min to yVED_max do vedjumpto(j,1); vedtrimline(); fit( vedthisline(), xVED_min, xVED_max ) -> line; for i from 1 to xVED_max-xVED_min+1 do line(i) -> c; if c = `B` or c = `C` then c-`B`+1 -> bug_id; i-1 -> bug_xW; yVED_max-j -> bug_yW; expand( result.world_buglist, bug_id ) -> result.world_buglist; [% bug_xW, bug_yW %] -> (result.world_buglist)(bug_id); ` ` -> c; endif; c -> (result.world_initial_chars)( i-1, yVED_max-j ); endfor; endfor; /* Locate food. */ if ( locate_in_world( result.world_initial_chars, `+` ) ->> food_yW ) = false then ;;; vederror( 'No food in world' ) ; else () -> food_xW; endif; objects_file -> result.world_objects_file; 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 initial 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, j, bounds=boundslist(chars); for i from bounds(1) to bounds(2) do for j from bounds(3) to bounds(4) do if chars(i,j) = c then return( i, j ); endif; endfor; 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;