Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w use strict; srand; use constant STACKSIZE => 128; use constant CODESIZE => 128; use constant SKIPAMOUNT => 2 + int rand 6; use constant REPEATAMOUNT => 2 + int rand 10; use constant NOP => 0; use constant SKIP => 1; use constant REPEAT => 2; use constant NOT => 3; use constant GO => 4; use constant TURN => 5; use constant LOOK => 6; use constant EAT => 7; use constant RESET => 8; use constant MAXOPCODE => 8; my @code = (); foreach(0..CODESIZE-1) { $code[$_] = RESET; } my @opcode = qw(NOP SKIP REPEAT NOT GO TURN LOOK EAT RESET); my @world = (); use constant WORLDWIDTH => 16; use constant WORLDHEIGHT => 16; use constant EMPTY => 0; use constant OBSTACLE => 1; use constant FOOD => 2; use constant PATH => 3; foreach my $y (0..WORLDHEIGHT) { foreach my $x (0..WORLDWIDTH) { $world[$y][$x] = EMPTY; unless(int rand 4) { $world[$y][$x] = FOOD; } } } foreach (1..sqrt(WORLDHEIGHT*WORLDWIDTH)) { my $x = int rand WORLDWIDTH; my $y = int rand WORLDHEIGHT; $world[$y][$x] = OBSTACLE; } my %tiletochar = ( EMPTY, " ", FOOD, "+", OBSTACLE, "#", PATH, "@", ); foreach my $y (0..WORLDHEIGHT-1) { foreach my $x (0..WORLDWIDTH-1) { print $tiletochar{$world[$y][$x]}; } print "\n"; } print "Press Enter to generate programming."; <>; print "\n"; foreach(0..int rand CODESIZE-1) { my $thisopcode = int rand MAXOPCODE; $code[$_] = $thisopcode; print "Opcode \#$_: $thisopcode ($opcode[$thisopcode])\n"; } my $x = -1; my $y = -1; while($x < 0 or $y < 0 or $x >= WORLDWIDTH or $y >= WORLDHEIGHT or $wo +rld[$y][$x] == OBSTACLE) { $x = int rand WORLDWIDTH; $y = int rand WORLDHEIGHT; } my @histx = (); my @histy = (); my @histh = (); my $heading = int rand 4; my @headings = qw(north east south west); use constant NORTH => 0; use constant EAST => 1; use constant SOUTH => 2; use constant WEST => 3; my $food = 0; my $alive = 1; my $pc = 0; # Program Counter my $turn = 0; print "Repeatamount:\t", REPEATAMOUNT, "\n"; print "Skipamount:\t", SKIPAMOUNT, "\n"; print "Press Enter to start simulation: "; <>; print "\n"; { my @stack = (); foreach(0..STACKSIZE-1) { $stack[$_] = 0; } my $sp = 0; # Stack Pointer, keeps track of stack size sub _pop { my $bit = pop @stack; $sp--; $sp = 0 if $sp < 0; $bit = 0 unless defined $bit; return $bit; } sub _push { my ($bit) = @_; if($sp < STACKSIZE) { push @stack, $bit; $sp++; } } sub _reset { @stack = (); $sp = 0; } } while($alive) { $turn++; printf "Turn \#% 4d\t", $turn; push @histx, $x; push @histy, $y; push @histh, $heading; $pc = 0 if $pc < 0; $pc = CODESIZE - 1 if $pc >= CODESIZE; my $ci = $code[$pc]; # Current Instruction print $opcode[$ci], "\t"; $pc++; # Just like CPUs do if($ci == NOP) { # Do nothing print "Doing nothing.\n"; } elsif($ci == SKIP) { my $bit = _pop; if($bit) { $pc += SKIPAMOUNT; print "Skipped ahead " . SKIPAMOUNT . " instructions.\n"; } else { print "Not skipped.\n"; } } elsif($ci == REPEAT) { my $bit = _pop; if($bit) { $pc -= REPEATAMOUNT; print "Repeating previous " . REPEATAMOUNT . " instruction +s.\n"; } else { print "Not repeating.\n"; } } elsif($ci == NOT) { my $bit = _pop; print $bit, " => "; $bit = $bit ? 0 : 1; _push $bit; print "$bit\n"; } elsif($ci == RESET) { _reset; $pc = 0; print "\n"; # $alive = 0; } elsif($ci == GO) { my $nx = $x; my $ny = $y; if($heading == NORTH) { $ny--; } elsif($heading == EAST) { $nx++; } elsif($heading == SOUTH) { $ny++; } elsif($heading == WEST) { $nx--; } if( $nx < 0 or $ny < 0 or $nx >= WORLDWIDTH or $ny >= WORLDHEIGHT or $world[$ny][$ny] == OBSTACLE ) { _push 0; print "Could not move.\n"; } else { $x = $nx; $y = $ny; _push 1; print "Moved $headings[$heading].\n"; } } elsif($ci == TURN) { $heading++; $heading = 0 if $heading > 3; print "Turned to $headings[$heading].\n"; } elsif($ci == LOOK) { my $nx = $x; my $ny = $y; if($heading == NORTH) { $ny--; } elsif($heading == EAST) { $nx++; } elsif($heading == SOUTH) { $ny++; } elsif($heading == WEST) { $nx--; } if($world[$ny][$nx] == FOOD) { _push 1; print "Saw food ahead!\n"; } else { _push 0; print "No food ahead.\n"; } } elsif($ci == EAT) { if($world[$y][$x] == FOOD) { _push 1; $world[$y][$x] = EMPTY; $food++; print "Eaten food.\n"; } else { _push 0; print "Could not eat.\n"; } } $pc++; $alive = 0 if $turn > 1000; } print "Finished. Food accumulated: $food.\n"; while($turn--) { my $x = pop @histx; my $y = pop @histy; $world[$y][$x] = PATH; } foreach my $y (0..WORLDHEIGHT-1) { foreach my $x (0..WORLDWIDTH-1) { print $tiletochar{$world[$y][$x]}; } print "\n"; }

In reply to Very Simple Stack-based Language by orkysoft

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (6)
As of 2024-04-19 07:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found