Skip to content

Instantly share code, notes, and snippets.

@tene

tene/curses.pl

Forked from djanatyn/curses.pl
Created July 17, 2011 00:08
Download ZIP

Revisions

  1. tene revised this gist Jul 17, 2011. 1 changed file with 36 additions and 16 deletions.
    52 changes: 36 additions & 16 deletions curses.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -1,28 +1,48 @@
    #!/usr/bin/perl -w
    # Use Moose for the Player class, and other slight improvements.
    package Player;
    use v5.10;
    use strict;
    use Curses;
    use Moose;

    has 'health' => (is => 'rw', isa => 'Int', default => 100);
    has 'x' => (is => 'rw', isa => 'Int');
    has 'y' => (is => 'rw', isa => 'Int');

    sub walk {
    my ($self, $ch) = @_;
    my %map = (
    h => [0,-1],
    j => [1,0],
    k => [-1,0],
    l => [0,1],
    );
    my ($y, $x) = @{$map{$ch}};
    $self->position($self->y + $y, $self->x + $x);
    }

    my %player = (
    'health' => 100,
    'x' => 5,
    'y' => 5,
    );

    sub walking {
    my $_ = getch;
    if (/h/) { $player{x}--; };
    if (/j/) { $player{y}++; };
    if (/k/) { $player{y}--; };
    if (/l/) { $player{x}++; };
    sub position {
    my ($self, $y, $x) = @_;
    if (defined $y and defined $x) {
    $self->y($y); $self->x($x);
    }
    return ($self->y, $self->x);
    }

    package main;
    use v5.10;
    use strict;
    use Curses;

    initscr;

    my $p = Player->new(x=>5, y=>10);

    while(1) {
    addch($player{y},$player{x},"@");
    move($player{y},$player{x});
    addch($p->position,"@");
    move($p->position);
    refresh;
    &walking;
    $p->walk(getch);
    clear;
    }

  2. @invalid-email-address Anonymous created this gist Jul 17, 2011.
    29 changes: 29 additions & 0 deletions curses.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,29 @@
    #!/usr/bin/perl -w
    use strict;
    use Curses;

    my %player = (
    'health' => 100,
    'x' => 5,
    'y' => 5,
    );

    sub walking {
    my $_ = getch;
    if (/h/) { $player{x}--; };
    if (/j/) { $player{y}++; };
    if (/k/) { $player{y}--; };
    if (/l/) { $player{x}++; };
    }

    initscr;

    while(1) {
    addch($player{y},$player{x},"@");
    move($player{y},$player{x});
    refresh;
    &walking;
    clear;
    }

    endwin;