#!/usr/bin/perl
#Author: V A Ramesh
use Curses;
use strict;
initscr(); #initiate alt.buffer of term for starting ncurses display
cbreak(); #disable line buffer
noecho(); #do-not display character entered on screen
keypad(1); #enable reading of arrow keys
curs_set(0); #do-not display cursor
start_color(); #Start color mode for displaying colors
#Initiating color pairs, first option is fore-ground color and second option is background color
init_pair( 1, COLOR_RED, COLOR_BLACK );
init_pair( 2, COLOR_GREEN, COLOR_BLACK );
init_pair( 3, COLOR_BLUE, COLOR_BLACK );
init_pair( 4, COLOR_YELLOW, COLOR_BLACK );
#Get max. possible rows and columns displayed on current terminal
#in nCurses, rows(y-axis) comes as first option, and columns(x-axis) comes as second option
getmaxyx( my $max_row, my $max_col );
#60% of max-cols is width of box, and 60% of max-rows is height of box
my $width = int( $max_col * 0.6 );
my $height = int( $max_row * 0.6 );
#start drawing box boundary at 20% th of max-rows and cols
my $startY = int( $max_row * 0.2 );
my $startX = int( $max_col * 0.2 );
#endY and endX are decided by height and width(60% of possible size of the screen)
my $endY = $startY + $height;
my $endX = $startX + $width;
#eggY, and eggX stores Y and X co-ordinates of eggs spawned by spawn_food func.
#pkey=Previous Key; $key=Current-key(for stroring directions)
#@snake; For storing snake co-ordinates
#@snake is AoA(Array of arrays, each element of parent array is array itself,
#having Y and X co-ordinates of that segment
#$time; stores time, gets from time() base perl function
#$timmer_running for controlling special eggs display
my ($eggX, $eggY, $score, $pkey,
$key, @snake, $eggs_eaten, $time,
$timmer_running, $i, $color_snake
);
#initate game
init_game();
#function to control snake movement, main logic for
# snake movement, collision detection, and
# score-keeping happens here
move_snake();
#exit game to terminal
game_over();
#restore-terminal settings and disable alt-buffer(opposite of initscr)
endwin();
#init-game initiates, displays, game name, draws-box, banner and initiates score display
#accespts option to display instructions or start game
sub init_game {
my $option = show_name();
if ( $option eq "i" ) {
instructions();
clear();
#make snake empty, for display purposes snake segments
#were popuplated in instructions function
@snake = ();
}
elsif ( $option eq "p" ) {
#continue with play
}
else {
game_over();
}
#nodelay disables blocking i/o, means i/o becomes non-blocking,
#means game loop doesn't wait for user to enter keys
nodelay(1);
banner();
draw_box();
init_snake();
spawn_food();
score(0);
}
sub move_snake {
while (1) {
$key = getch();
if ( $key == -1 ) {
#If No-key is registered, key will be previous key
$key = $pkey;
}
elsif ( $key eq 'c' ) {
$color_snake = ( $color_snake == 1 ? 0 : 1 );
$key = $pkey;
}
elsif ( $key eq 'q' ) {
#exit game if key hit is "q"
last;
}
#Check if LegalKey or not, snake can't go right,
#when snake is moving left, etc
elsif ( $pkey == KEY_LEFT && $key == KEY_RIGHT ) {
next;
}
elsif ( $pkey == KEY_RIGHT && $key == KEY_LEFT ) {
next;
}
elsif ( $pkey == KEY_UP && $key == KEY_DOWN ) {
next;
} Write, Run & Share Perl code online using OneCompiler's Perl online compiler for free. It's one of the robust, feature-rich online compilers for Perl language, running on the latest version 5.22.1. Getting started with the OneCompiler's Perl compiler is simple and pretty fast. The editor shows sample boilerplate code when you choose language as Perl and start coding.
OneCompiler's Perl online editor supports stdin and users can give inputs to programs using the STDIN textbox under the I/O tab. Following is a sample Perl program which takes name as input and prints hello message with your name.
my $name = <STDIN>;
print "Hello $name.\n";
Perl(Practical Extraction and Report Language) is especially desined for text processing by Larry Wall.
There is no need to specify the type of the data in Perl as it is loosely typed language.
| Type | Description | Usage |
|---|---|---|
| Scalar | Scalar is either a number or a string or an address of a variable(reference) | $var |
| Arrays | Array is an ordered list of scalars, you can access arrays with indexes which starts from 0 | @arr = (1,2,3) |
| Hash | Hash is an unordered set of key/value pairs | %ul = (1,'foo', 2, 'bar) |
In Perl, there is no need to explicitly declare variables to reserve memory space. When you assign a value to a variable, declaration happens automatically.
$var-name =value; #scalar-variable
@arr-name = (values); #Array-variables
%hashes = (key-value pairs); # Hash-variables
If, If-else, Nested-Ifs are used when you want to perform a certain set of operations based on conditional expressions.
if(conditional-expression){
//code
}
if(conditional-expression){
//code if condition is true
}else{
//code if condition is false
}
if(condition-expression1){
//code if above condition is true
}else if(condition-expression2){
//code if above condition is true
}
else if(condition-expression3){
//code if above condition is true
}
...
else{
//code if all the conditions are false
}
There is no case or switch in perl, instead we use given and when to check the code for multiple conditions.
given(expr){
when (value1)
{//code if above value is matched;}
when (value2)
{//code if above value is matched;}
when (value3)
{//code if above value is matched;}
default
{//code if all the above cases are not matched.}
}
For loop is used to iterate a set of statements based on a condition.
for(Initialization; Condition; Increment/decrement){
// code
}
While is also used to iterate a set of statements based on a condition. Usually while is preferred when number of iterations are not known in advance.
while(condition) {
// code
}
Do-while is also used to iterate a set of statements based on a condition. It is mostly used when you need to execute the statements atleast once.
do {
// code
} while (condition);
Sub-routines are similar to functions which contains set of statements. Usually sub-routines are written when multiple calls are required to same set of statements which increases re-usuability and modularity.
sub subroutine_name
{
# set of Statements
}
subroutine_name();
subroutine_name(arguments-list); // if arguments are present