#!/usr/bin/perl
#
# Vexed in Perl-SDL
#
# by Krzysiek Koziarek <krzynio@apcoh.org>
#
# This game is a clone of a PalmOS game "Vexed" (http://vexed.sf.net)
#
# Some code borrowed from or inspired by Frozen-Bubble code.
#
# -+- !apcohforce -+-

use SDL::App;
use SDL::Surface;
use SDL::Event;
use SDL::Font;
use SDL::SFont;
use SDL::Constants;
use SDL::Mixer;

use strict;

# global variables...

my ($app, $music, $event, $background,  $background_orig, $backgr, $ag, $keypressed, %rects, %sound, $font, $smallfont, $savefile, %sound, $PREFIX,
    $display_on_app_disabled, $mixer, $mixer_enabled, %sound, %ia, $TARGET_ANIM_SPEED, $FLOW_ANIM_SPEED, $MAIN_LOOP_SPEED,$SAVE_DIR);

my $DEBUG=0;
my $VERSION='0.6';

my @update_rects; my @undo;

&init;


&qscroll_add("Welcome to Vexed $VERSION!!!");

#----[ main loop ]------------------------------------------------------------------------------------------------#

while(1){
    $event->pump();

    if ($event->poll != 0) {
	$keypressed = $event->key_sym();

	if ($event->type == SDL_KEYDOWN){ 
	    last if ($keypressed==27);
	    if ($keypressed==SDLK_f) { $app->fullscreen(); $ag->{fullscreen}=! $ag->{fullscreen} };
	    if ($keypressed==SDLK_u) { &undo;};
	    if ($keypressed==SDLK_r && $ag->{moves}) { &board;}; # reset the board only when there was at least one move made by player.
	    if ($keypressed==SDLK_s) { &solution;};
	    if ($keypressed==SDLK_F1) { &about;};
	    if ($keypressed==SDLK_l) { &levelpack_choose};
	    if ($keypressed==SDLK_m) { 
		if ($mixer_enabled) {
		    if ($ag->{music}) {$mixer->pause_music(); $ag->{music}=0 } else { $mixer->resume_music(); $ag->{music}=1 };
		}
	    }
	    
	}	
	last if $event->type==SDL_QUIT;
	
	if ($event->type==SDL_MOUSEBUTTONDOWN && !$ag->{mouse_down}){
	    $ag->{mx}=$event->motion_x();
	    $ag->{my}=$event->motion_y();
	    $ag->{mouse_down}=1;
	}
	
	if (($event->type==SDL_MOUSEBUTTONUP && $ag->{mouse_down} )){
	    $ag->{enforce_move}=1;
	    while ($ag->{enforce_move}){
		&check_move;
		#&loser;
	    }
	}
    }
    #&qscroll;
    $app->delay( $MAIN_LOOP_SPEED); # we don't need screen updates in main loop - all animations are event driven
}

&save; 

##################################################################################################################


#### functions ...

sub loser { # annoy the user with silly message when needed :)
    my %blocks;
    my $loser=0;
    for (my $y=0; $y < 8; $y++){ # is the board solvable?
        for (my $x=0; $x < 10; $x++){
	    if ($ag->{p}[$x][$y] && $ag->{p}[$x][$y] !=9){
		$blocks{$ag->{p}[$x][$y]}++;
	    }
        }
    }
    foreach (keys %blocks){
	if ($blocks{$_} ){
	    if ($blocks{$_}==1){
		$loser=1;
	    }
	}
    }
    
    if ($loser){
	&qscroll_add('You lose, try again!');
    }
}

sub qscroll {
    if ($ag->{qscrolltime} != time){
	for (my $i=19; $i > 1; $i--){
	    &render_text("qs$i", $ag->{skin}->{levelpack_p},$ag->{skin}->{smallfont_height}, $ag->{skin}->{levelpackimg_x}+250, $ag->{skin}->{levelpackimg_y}+100+$i*$ag->{skin}->{smallfont_height}, $ag->{qscroll}[$i], 'small');
	}
	$ag->{qscrolltime}=time;
	shift @{$ag->{qscroll}};
    }

    
}

sub qscroll_add{
    shift @{$ag->{qscroll}};
    $ag->{qscroll}[19]=$_[0];
} 

sub save {
    open FH, ">$savefile" or die $!;
    print FH "# vexed save file\nlevelpack = $ag->{levelpack}\nfullscreen = $ag->{fullscreen}\nmusic = $ag->{music}\n";
    print "# vexed save file\nlevelpack = $ag->{levelpack}\nfullscreen = $ag->{fullscreen}\nmusic = $ag->{music}\n" if $DEBUG;
    close FH;
    open FH, ">$SAVE_DIR/$ag->{levelpack}.save";
    print FH "# vexed save: $ag->{levelpack}\nlevel = $ag->{level}\npoints = $ag->{points}\n";
    close FH;

}

sub levelpack_choose {
    opendir DH, "$PREFIX/levelpacks";

    my (@packs);
   
    my $i;

    foreach (readdir(DH)){
	if ($_ !~ /^\.{1,2}$/){
	    $_=~ s/\.pdb$//;
	    print "levelpack: $_\n" if ($DEBUG);
	    push @packs, $_;
	    if ($_ eq $ag->{levelpack}){
		$i=$#packs;
		print "Current levelpack found: #$i ($packs[$i])\n" if ($DEBUG);
	    }
	}
    }
    closedir DH;
    &remove_image_from_background($ia{levelpack}, $ag->{skin}->{levelpackimg_x},$ag->{skin}->{levelpackimg_y}) ;
    &put_image_to_background($ia{levelpack}, $ag->{skin}->{levelpackimg_x},$ag->{skin}->{levelpackimg_y}) ;
    &render_text("lpcg", $ag->{skin}->{levelpack_p},$ag->{skin}->{smallfont_height}, $ag->{skin}->{levelpackimg_x}+10, $ag->{skin}->{levelpackimg_y}+10, "Choose your level pack:",'small', 'noclear');
    
    &render_text("lpc", $ag->{skin}->{levelpack_p},$ag->{skin}->{smallfont_height}, $ag->{skin}->{levelpack_x}, $ag->{skin}->{levelpack_y}, $packs[$i],'small', 'noclear');

    my $j=$i;
    
    my $ok;

    while (1){
	
	$event->pump();
	
	if ($event->poll != 0) {
	    $keypressed = $event->key_sym(); # turbo pascal :>
	    
	    if ($event->type == SDL_KEYDOWN){
		last if ($keypressed==27);
		if ($keypressed == SDLK_q){
		    die "Thank you for playing :)";
		}

		if ($keypressed == SDLK_RETURN ){
		    $ok=1;
		    last;
		}
		
		if ($keypressed == SDLK_UP || $keypressed == SDLK_DOWN){
		    
		    &remove_image_from_background($ia{levelpack}, $ag->{skin}->{levelpackimg_x},$ag->{skin}->{levelpackimg_y}) ;
		    &put_image_to_background($ia{levelpack}, $ag->{skin}->{levelpackimg_x},$ag->{skin}->{levelpackimg_y}) ;
		    &render_text("lpcg", $ag->{skin}->{levelpack_p},$ag->{skin}->{smallfont_height}, $ag->{skin}->{levelpackimg_x}+10, $ag->{skin}->{levelpackimg_y}+10, "Choose your level pack:",'small', 'noclear');
		    
		    
		    if ($keypressed == SDLK_UP ) { $j++;  if ($j > $#packs) {$j=$#packs }   };
		    if ($keypressed == SDLK_DOWN ) { $j--;  if ($j <0) {$j=0 }   };
		    
		    &render_text("lpc", $ag->{skin}->{levelpack_p},$ag->{skin}->{smallfont_height}, $ag->{skin}->{levelpack_x}, $ag->{skin}->{levelpack_y}, $packs[$j],'small', 'noclear');
		    
		}
		
		$app->flip();
		$app->delay( $MAIN_LOOP_SPEED);
	    }
	    

	}
    }
    
    &clear_text("lpc"); &clear_text("lpcg");
    &remove_image_from_background($ia{levelpack}, $ag->{skin}->{levelpackimg_x},$ag->{skin}->{levelpackimg_y}) ;

    &redraw;
    $app->update(@update_rects);
    @update_rects = ();
    

    if ($ok && $j != $i){
	print "New levelpack chosen: $packs[$j] ($j)\n" if ($DEBUG);
	&save;
	$ag->{levelpack}="$packs[$j]";
	&load('changelevelpack');
	&board;
	$app->flip;
	#$event->pump while ($event->poll != 0);
    }

}



sub load {
    my ($type)=(@_);
    my %tmp;

    if ($type ne 'changelevelpack'){
	if (-e $savefile){
	    open FH, $savefile or die $!;
	    while (<FH>){
		if ($_ !~ /^#/){ 
		    chomp $_;
		    my ($key, $val)=split /[\s\t]*=[\s\t]*/;
		    $tmp{$key}=$val;
		    print "load ($savefile): $_\n" if ($DEBUG);
		    
		}		
	    }
	    close FH;
	} else { # huh? first run? turn on music...
	    $ag->{music}=1;
        }
	
        # set fullscreen if needed...
	$ag->{fullscreen}=$tmp{fullscreen}; $app->fullscreen() if ($ag->{fullscreen});
	$ag->{music}=$tmp{music} if (!$ag->{music});
        # make Classic Levels default if there is no level pack defined
	$tmp{levelpack}='Classic Levels' if (!$tmp{levelpack}); $ag->{levelpack}=$tmp{levelpack};
	
    }

    if (-e "$SAVE_DIR/$ag->{levelpack}.save"){ # load levelpack specific values
	
	open FH, "$SAVE_DIR/$ag->{levelpack}.save";
	
	print "open ($SAVE_DIR/$ag->{levelpack})\n" if ($DEBUG);
	
	while (<FH>){
	    if ($_ !~ /^#/){
		chomp $_;
		my ($key, $val)=split /[\s\t]*=[\s\t]*/;
		$tmp{$key}=$val;
	    }
	}
	
	close FH; 
    }
	$ag->{level}=$tmp{level};
	$ag->{points}=$tmp{points};
   

}

sub about {
    &put_image($ia{about}, $ag->{skin}->{about_x},$ag->{skin}->{about_y}) ;
    $app->update(@update_rects);
    @update_rects = ();

    while (1){
	$event->pump();
	my $typ=$event->type;
	if ($event->poll != 0) {
	    last if ($event->type == SDL_KEYDOWN || $event->type==SDL_MOUSEBUTTONDOWN);
	}
	$app->delay(50);
    }
    &erase_image($ia{about}, $ag->{skin}->{about_x},$ag->{skin}->{about_y}) ;
    &redraw;
    $app->update(@update_rects);
    @update_rects = ();
}



sub check_move {
    $ag->{mxx}=$event->motion_x();
    $ag->{enforce_move}=0;
    my $savemx=$ag->{mx};
    $ag->{mx}-= ( $ag->{mx}-$ag->{sx}) % 32; 
    $ag->{my}-= ( $ag->{my}-$ag->{sy}) % 32;
    $ag->{mxx}-= ( $ag->{mxx}-$ag->{sx}) % 32;
    $ag->{mouse_down}=0;
    my ($px, $py)=&stob($ag->{mx}, $ag->{my});
    my ($mx, $my)=&stob($ag->{mxx}, $ag->{my});
    my $nx=$mx;
    if ($mx != $px){
	print "Move: $px,$py -> $mx,$my\n" if $DEBUG;
       	if ($ag->{p}[$px][$py] > 0  && $ag->{p}[$px][$py] < 9){
	    if ($px < $mx){ $mx=$px+1; $savemx+=32;} elsif ($px > $mx) { $mx=$px-1; $savemx-=32};   
	    if ($ag->{p}[$mx][$my] !=9 && ! $ag->{p}[$mx][$my]){
		&undo_add;
		&move_block($px, $py, $mx, $my);
		my $grav=&gravity;
		$ag->{moves}++;
		&title_text;
		if ($nx !=$mx && ! $grav){
		    $ag->{enforce_move}=1;
		    $ag->{mx}=$savemx;
		}
	    }
	}
    }
    &check_level;
}

sub solution { # show solution
    my $sol=$ag->{solution};
    my $board=&board2ascii;
    
    if ($ag->{moves}){ # recall original board
	&ascii2board($undo[$#undo]);
    }

    my ($x1, $x2, $y);
    $sol=~ s/(..)/$1,/g; $sol=~ s/,$//;
    foreach (split /,/, $sol){
	($x1, $y)=split//,$_;
	$x1=(ord(uc($x1))-65); $y=(ord(uc($y))-65);
	if ($_=~ /^[A-J]/){
	    $x2=$x1-1;
	} else {
	    $x2=$x1+1;
	}
	&move_block($x1, $y, $x2, $y);
	&gravity;
	$app->flip();
	$app->delay(200);
    }
    sleep 1;
    $ag->{points}+=5;
    &ascii2board($board);
    $event->pump while ($event->poll != 0);
};


sub redraw {
    &ascii2board(&board2ascii);
    &title_text;
}

sub clear_board {
    &clear_to_background($ag->{sx}, $ag->{sy}, $ag->{sx}+320, $ag->{sy}+256); 
}

sub board2ascii { # creates ascii string with a board;
    my $tmp;
    for (my $y=0; $y < 8; $y++){
        for (my $x=0; $x < 10; $x++){
            $tmp.=sprintf "%d", $ag->{p}[$x][$y];
        }
    }
    return $tmp;
}

sub ascii2board { # unpack the string with board
    my ($tmp)=(@_);
    my (@tab)=split//,$tmp;
    &clear_board;
    for (my $y=0; $y < 8; $y++){
	for (my $x=0; $x < 10; $x++){
	    my $n=shift(@tab);
	    if ($n){
		    &put_block($n, $x, $y);
                } else {
                    &erase_block(10, $x, $y);
                }
            }
    }
    &title_text;
}

sub undo_add {
    unshift @undo, &board2ascii;
}


sub undo {
    my $tmp=shift(@undo);
    if ($tmp){
	$ag->{moves}--;
	&ascii2board($tmp);
    }
    &title_text;
}

sub check_level { # check for level completion and load new board if needed
    my $blocks=0;
    for (my $y=0; $y < 8; $y++){
	for (my $x=0; $x < 10; $x++){
	    if ( $ag->{p}[$x][$y] > 0 && $ag->{p}[$x][$y] < 9){
		$blocks++;
	    }
	}
    }
    if (!$blocks){
	$ag->{level}++;  
	$ag->{points} += ($ag->{moves} - $ag->{sol_moves});
       	&board;
	&save;
	$ag->{mouse_down}=0;
    }
}

sub gravity { # gravity check and neighbors' removal check
    my ($intro)=(@_);
    
    my $gravity=1;
    my $change;
    my $range=$intro ? 17 : 9;

    while ($gravity){
	while ($gravity){
	    $gravity=0;
	    for (my $y=0; $y < 7; $y++){ 
		for (my $x=0; $x < $range+1; $x++){
		    if ($ag->{p}[$x][$y] > 0 && $ag->{p}[$x][$y] < 9 && ! $ag->{p}[$x][$y+1]){
			&move_block($x, $y, $x, $y+1);
			$gravity=1;
			$change=1;
			if ($ag->{p}[$x][$y+1] > 0 &&  $ag->{p}[$x][$y+2]){
			    &play_sound('smash');
			}
		    }
		}
	    }
	}
	$gravity=&dissapear($intro); # check and remove groups of blocks and set $gravity if needed 
    }
    return $change;
}

sub dissapear {
    my ($intro)=(@_);
    my @dx; my @dy; my @dis;
    my $discount;
    my $range=$intro ? 17 : 9;
    for (my $y=1; $y < 7; $y++){
	for (my $x=1; $x < $range; $x++){
	    my $n=$ag->{p}[$x][$y];
	    if ($n > 0 && $n < 9){
		if ( $ag->{p}[$x+1][$y] == $n){
		     $discount=1;
		     if (! $dis[$x][$y]){ push @dx, $x; push @dy, $y; $dis[$x][$y]=1 }
		     if (! $dis[$x+1][$y]){ push @dx, $x+1; push @dy, $y; $dis[$x+1][$y] }	
		 }
		 if ( $ag->{p}[$x-1][$y] == $n){
		     $discount=1;
		     if (! $dis[$x][$y]){ push @dx, $x; push @dy, $y; $dis[$x][$y]=1 }
		     if (! $dis[$x-1][$y]){ push @dx, $x-1; push @dy, $y; $dis[$x-1][$y]=1 }
		     
		 }
		 if ( $ag->{p}[$x][$y+1] == $n){
		     $discount=1;
		     if (! $dis[$x][$y]){ push @dx, $x; push @dy, $y; $dis[$x][$y]=1 }
		     if (! $dis[$x][$y+1]){ push @dx, $x; push @dy, $y+1; $dis[$x][$y+1]=1  }
		 }
		if ( $ag->{p}[$x][$y-1] == $n){
		     $discount=1;
		     if (! $dis[$x][$y]){ push @dx, $x; push @dy, $y; $dis[$x][$y]=1 }
		     if (! $dis[$x][$y-1]){ push @dx, $x; push @dy, $y-1; $dis[$x][$y-1]=1 }
		 }
	    }
	}
    }

    for (my $i=0; $i < $#dx+1; $i++){
	&blink_block( $ag->{p}[ $dx[$i] ][ $dy[$i] ] , $dx[$i], $dy[$i]);
	&erase_block( $ag->{p}[ $dx[$i] ][ $dy[$i] ], $dx[$i], $dy[$i]);
    }
    return $discount;
}

sub stob { # convert screen <-> board coordinates
    my ($x, $y)=(@_);
    $x-=$ag->{sx};
    $y-=$ag->{sy};
    $x=($x-$x % 32)/32;
    $y=($y-$y % 32)/32;
    return ($x, $y)
}

sub move_block {
    my ($x1, $y1, $x2, $y2)=(@_); 
    my $n=$ag->{p}[$x1][$y1];
    &erase_block($n, $x1, $y1);
    &smooth_move($n, $x1,$y1, $x2, $y2);
    &put_block($n, $x2, $y2)
}

sub board {
   
    my $txt;

    while (!$txt){

	$txt=&load_level($ag->{level});
	
	if ($txt){
	    my $x=9; my $y=7;
	    &clear_board;
	    foreach (reverse split /\n/, $txt){
		foreach (reverse split //, $_){
		    my $n;
		    $ag->{p}[$x][$y]='';
		    if ($_ eq "#"){ $n=9};
		    if ($_=~ /[A-H]/){ $n=ord($_)-64; }
		    if ($n){
			&put_block($n, $x, $y);
		    } else {
			&erase_block(10, $x, $y);
		    }
		    $x--;
		}
		$y--;
		$x=9;
	    };
	    $ag->{moves}=0;
	    @undo=();
	    &title_text;
	    return 1;
	} else {
	    print "You've finished this Levelpack!!!\n";
	    &levelpack_choose;
	}
    }
}
    
sub title_text {

    # level name
    &render_text('ln', $ag->{skin}->{title_p}, $ag->{skin}->{font_height}, $ag->{skin}->{title_x},$ag->{skin}->{title_y}, "$ag->{levelpack}: $ag->{level_name}");
    
    # level number
    &render_text('ll', $ag->{skin}->{levelnum_p}, $ag->{skin}->{font_height}, $ag->{skin}->{levelnum_x},$ag->{skin}->{levelnum_y},(sprintf "%d", $ag->{level}));

    # score

    my $points=sprintf "%d", ($ag->{points} + ( $ag->{sol_moves} < $ag->{moves}) * ($ag->{moves} - $ag->{sol_moves}));
    &render_text('lp', $ag->{skin}->{score_p}, $ag->{skin}->{font_height}, $ag->{skin}->{score_x}, $ag->{skin}->{score_y}, $points);

    # moves
    
    &render_text('lm', 
		 $ag->{skin}->{moves_p}, 
		 $ag->{skin}->{font_height}, 
		 $ag->{skin}->{moves_x},
		 $ag->{skin}->{moves_y}, 
		 sprintf "%d",$ag->{moves}
		 );

    &render_text('lq',
                 $ag->{skin}->{par_p},
                 $ag->{skin}->{font_height},
                 $ag->{skin}->{par_x},
                 $ag->{skin}->{par_y},
                 sprintf "%d", $ag->{sol_moves}
                 );


}

sub render_text {
    my ($name, $p, $h, $x1, $y1, $text, $type, $noclear)=@_;

    if ($type eq 'small') {    $smallfont->use() } else { $font->use() };

    if ($p eq 'R'){
	$x1-=SDL::SFont::TextWidth($text);
    }
    if (! $noclear){
	&clear_text($name);
    }

    $app->print($x1,$y1, $text);
    $ag->{font}->{$name}->{x1}=$x1;$ag->{font}->{$name}->{y1}=$y1;
    $ag->{font}->{$name}->{x2}=$x1+SDL::SFont::TextWidth($text); $ag->{font}->{$name}->{y2}=$y1 + $h;
    $app->flip;
}

sub clear_text {
    my ($name)=(@_);
    if ($ag->{font}->{$name}->{x1}){ # clear text
        &clear_to_background($ag->{font}->{$name}->{x1}, $ag->{font}->{$name}->{y1}, $ag->{font}->{$name}->{x2}, $ag->{font}->{$name}->{y2});
    }
}


sub put_block {
    my ($n, $x, $y, $offset)=(@_);
    if ($n){
	
	&put_image_to_background($ia{ $n }, $offset+$ag->{sx} + $x * 32, $ag->{sy} + $y*32 );
	if ($n < 10 && $x>=0) {
	    $ag->{p}[$x][$y]=$n;
	}
    }    
}

sub blink_block {
    my ($n, $x, $y)=(@_);
    if ($n){
        for (my $i=0; $i < 4; $i++){
	    clear_to_background($ag->{sx} + $x * 32, $ag->{sy} + $y*32, $ag->{sx} + ($x+1) * 32, $ag->{sy} + ($y+1)*32);
	    $app->update(@update_rects);
            @update_rects = ();
            if ($i < 3){
                $app->delay(40);
                &put_image($ia{ $n }, $ag->{sx} + $x * 32, $ag->{sy} + $y*32 );
                $app->update(@update_rects);
                @update_rects = ();
                $app->delay(20);
            }
        }
    }
}

sub erase_block {
    my ($n, $x, $y)=(@_);
    if ($n){
	remove_image_from_background($ia{9}, $ag->{sx} + $x * 32, $ag->{sy} + $y*32 );
	$ag->{p}[$x][$y]='';
   }
}

sub smooth_move {
    my ($n, $x1, $y1, $x2, $y2, $s,$offset)=(@_);
    my $kx=$x2;
    my $ky=$y2;
    $x1=($x1*32)+$ag->{sx}+$offset;
    $x2=($x2*32)+$ag->{sx}+$offset;
    $y1=($y1*32)+$ag->{sy};
    $y2=($y2*32)+$ag->{sy};
    if ($x1 != $x2){
	$s=2 if (!$s);
	if ($x2 > $x1){
	    for (my $x=$x1+$s; $x < $x2+$s; $x+=$s){
		my $synchro_ticks=$app->ticks();
		&erase_image($ia{ $n }, $x-$s, $y1 );
		&put_image($ia{ $n }, $x,$y1);
		$app->update(@update_rects);
		@update_rects = ();
		my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks() - $synchro_ticks);
		if ($to_wait < 0 || $to_wait > $TARGET_ANIM_SPEED ) { $to_wait= $TARGET_ANIM_SPEED };
		$app->delay($to_wait);
	    }
	}


	if ($x2 < $x1){
            for (my $x=$x1-$s; $x > $x2-$s; $x-=$s){
                my $synchro_ticks=$app->ticks();
                &erase_image($ia{ $n }, $x+$s, $y1 );
                &put_image($ia{ $n }, $x,$y1);
                $app->update(@update_rects);
                @update_rects = ();
                my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks() - $synchro_ticks);
                if ($to_wait < 0 || $to_wait > $TARGET_ANIM_SPEED ) { $to_wait= $TARGET_ANIM_SPEED };
                $app->delay($to_wait);
            }
        }
    }
    
    if ($y2 > $y1){ # ruch w pionie
	$s=3 if (!$s);
	for (my $y=$y1+$s; $y < $y2+$s; $y+=$s){
	    my $synchro_ticks=$app->ticks();
	    &erase_image($ia{ $n}, $x1, $y-$s );
	    if ($y < $y2){
		&put_image($ia{ $n }, $x1,$y);
	    } else {
		&put_image($ia{ $n }, $x1,$y-1);
	    }
	    $app->update(@update_rects);
	    @update_rects = ();
	    my $to_wait = $FLOW_ANIM_SPEED - ($app->ticks() - $synchro_ticks);
	    if ($to_wait < 0 || $to_wait > $FLOW_ANIM_SPEED ) { $to_wait= $FLOW_ANIM_SPEED };
	    $app->delay($to_wait);
	}
    }
}

### initialization

sub init {

print <<EOF;

------- Vexed $VERSION ----------------------------------------------------


coded by krzynio <krzynio\@apcoh.org>,

gfx taken from original vexed; some gfx made by anonymous vexed player,

msx by lancaster.


Enjoy...


---------------------------------------------------------------------------

EOF


    $PREFIX='.';

    &load_skin("$PREFIX/gfx/skin.txt");

    # create a new sdl application
    $app = new SDL::App  
	-width => $ag->{skin}->{window_x}, 
	-height => $ag->{skin}->{window_y},
	-title => 'Perl-SDL Vexed'
	or die $!;
    $event = new SDL::Event;
    
    ### set initial values for couple of variables
    
    $TARGET_ANIM_SPEED=10;
    $MAIN_LOOP_SPEED=5;
    $FLOW_ANIM_SPEED=6;
    $SAVE_DIR="$ENV{HOME}/.vexed";
    
    my $high_rect = new SDL::Rect('-x' => 0 , '-y' =>  0,
                                  '-width' => $ag->{skin}->{window_x}, -height => $ag->{skin}->{window_y});
    
    $background = new SDL::Surface(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
    $background_orig = new SDL::Surface(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
    

    
    # load images
    for (my $i=1; $i < 11; $i++){
	$ia{$i}=&add_image("block$i.png");
    }	      
    
    $ia{about}=&add_image("about.png");
    $ia{levelpack}=&add_image("levelpack.png");

    $mixer = eval { new SDL::Mixer(-frequency => 44100, -channels => 2, -size => 1024); };
    if ($@) {
	$@ =~ s| at \S+ line.*\n||;
	warn "\nWarning: can't initialize sound (reason: $@).\n";
      
    } else {
	
	my @sounds = qw(smash pop);
	foreach (@sounds) {
	    my $sound_path = "$PREFIX/gfx/$_.wav";
	    $sound{$_} = new SDL::Sound($sound_path);
	    if ($_ eq 'pop'){
		$sound{$_}->volume(25);
	    } else {
		$sound{$_}->volume(90);
	    }
	}
	$mixer_enabled=1;
    }
 
    $font = SDL::Font->new("$PREFIX/gfx/font1.png") or die $!;
    $smallfont = SDL::Font->new("$PREFIX/gfx/font2.png") or die $!;
    $font->use();
    
    # check for save game and config directory

    if (! -e $SAVE_DIR) { 
	mkdir $SAVE_DIR or die "Cannot create savegame directory $!";
    }

    $savefile="$SAVE_DIR/save";
    &load;

    &intro;
    $backgr= new SDL::Surface(-name => "$PREFIX/gfx/tlo.jpg");
    $backgr->blit($high_rect,$app,$high_rect);
    $backgr->blit($high_rect, $background, $high_rect);
    $backgr->blit($high_rect, $background_orig, $high_rect);
    if ($mixer_enabled){ # enable music if needed
       $music = new SDL::Music("$PREFIX/gfx/vexed.xm");
       $mixer->play_music($music, -1);
       if (!$ag->{music}){
	   $mixer->pause_music();
       }
    }



    &board;
    $event->pump while ($event->poll != 0);

}


sub intro {
    my ($high_rect)=(@_);
    $backgr= new SDL::Surface(-name => "$PREFIX/gfx/intro.jpg");
    $backgr->blit($high_rect,$app,$high_rect);
    $backgr->blit($high_rect, $background, $high_rect);
    $backgr->blit($high_rect, $background_orig, $high_rect);

    $app->flip;

# 

my $ruchy='0,2 2,2 0,3 2,3 0,4 2,4 0,5, 2,5 1,6
4,2 5,2 4,3 4,4 5,4 5,6 4,5 4,6
7,2 9,2 7,3 9,3 8,4 7,5 9,5 7,6 9,6
11,2 12,2 11,3 11,4 12,4 12,6 11,5 11,6
14,2 15,2 14,3 16,3 14,4, 16,4 14,5 16,5 14,6 15,6';

srand time;


my @rtab=split / |\n/, $ruchy;

my %wh;

for (my $i=0; $i < 1+$#rtab+1; $i++){
    if ($rtab[$i]){
	$wh{ int(rand(1000)) . $i}=$i;
    }
};

my @spid=(8,16,32);
my $last;
for (my $x=-1; $x < 19; $x++){
    &put_block(9,$x,7);
    &put_block(9,17-$x,1);
    $app->flip;
    if ($event->poll != 0) {
            if ($event->type == SDL_KEYDOWN){
                     $last=1; last;
            }
    }
}

if (!$last){
	foreach (sort keys %wh){
	    my $ruch=$rtab[$wh{$_}];
	    my $block=1+int(rand(8));
	    my ($x,$y)=split /,/, $ruch;
    
	    my $vert=int(rand(3));
    
	    print "v=$vert - $x,$y\n" if $DEBUG;
    
	    my $s=$spid[int(rand(3))];

	    if ($event->poll != 0) {
	                if ($event->type == SDL_KEYDOWN){
				$last=1; last;
			}	
	    }

	    if ($vert==0){
		&smooth_move($block, -1, $y, 1+$x,$y, $s);
	    }  elsif ($vert==1){
		&smooth_move($block, 1+$x, -4, 1+$x,$y, $s);
	    } elsif ($vert==2){
		&smooth_move($block, 20, $y, 1+$x,$y, $s);
	    }
	    &put_block($block,1+$x,$y);
	    $app->flip;
	}
}

if (!$last){
	sleep 1;
	&gravity(1);
	sleep 1;
}

# clean up the board after intro...

for (my $i=0; $i < 1+$#rtab+1; $i++){
    if ( $rtab[$i]){
	my ($x,$y)=split /,/, $rtab[$i];
	$ag->{p}[1+$x][$y]='';
    }
}


}


sub load_skin {
    my ($skinfile)=@_;
    if (-e $skinfile){
        my %tmp;
        open FH, $skinfile or die $!;
	while (<FH>){
            if ($_ !~ /^#/){
		chomp $_;
		#print "\t$_\n";
                my ($key, $val)=split /[\s\t]*=[\s\t]*/;
                $tmp{$key}=$val;

            }
        }

	close FH;

        # set appropriate values...
	#
	# box
        ($ag->{sx}, $ag->{sy})=split /,/,$tmp{box};
        
       	# level title
	($ag->{skin}->{title_x}, $ag->{skin}->{title_y}, $ag->{skin}->{title_p})=split /,/,$tmp{title}; 

	# score 
	($ag->{skin}->{score_x}, $ag->{skin}->{score_y}, $ag->{skin}->{score_p})=split /,/,$tmp{score};
	
	# level number
        ($ag->{skin}->{levelnum_x}, $ag->{skin}->{levelnum_y}, $ag->{skin}->{levelnum_p})=split /,/,$tmp{levelnum};

	# moves
        ($ag->{skin}->{moves_x}, $ag->{skin}->{moves_y}, $ag->{skin}->{moves_p})=split /,/,$tmp{moves};

	# levelpack chooser

	($ag->{skin}->{levelpack_x}, $ag->{skin}->{levelpack_y}, $ag->{skin}->{levelpack_p})=split /,/,$tmp{levelpackline};

	($ag->{skin}->{levelpackimg_x}, $ag->{skin}->{levelpackimg_y})=split /,/,$tmp{levelpack};

	# font height

	$ag->{skin}->{font_height}=$tmp{font_height};
	
	$ag->{skin}->{smallfont_height}=$tmp{smallfont_height};

	# about
	
	($ag->{skin}->{about_x}, $ag->{skin}->{about_y})=split /,/,$tmp{about};

	# window

	($ag->{skin}->{window_x}, $ag->{skin}->{window_y})=split /,/,$tmp{window};

	# par moves 

	($ag->{skin}->{par_x}, $ag->{skin}->{par_y}, $ag->{skin}->{par_p})=split /,/,$tmp{par};

	
    }
}


sub play_sound($) {
    $mixer_enabled && $mixer && $sound{$_[0]} and $mixer->play_channel(-1, $sound{$_[0]}, 0);
}

sub add_image($) {
    my $file = "$PREFIX/gfx/$_[0]";
    my $img = new SDL::Surface(-name => $file) or die "FATAL: Couldn't load `$file' into a SDL::Surface.\n";
    add_default_rect($img);
    return $img;
}

sub add_default_rect($) {
    my ($surface) = @_;
    $rects{$surface} = new SDL::Rect(-width => $surface->width, -height => $surface->height);
}

sub put_image($$$) {
    my ($image, $x, $y) = @_;
    ($x == 0 && $y == 0) and print "put_image: warning, X and Y are 0\n";
    $rects{$image} or die "please don't call me with no rects\n";
    my $drect = new SDL::Rect(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    $image->blit($rects{$image}, $app, $drect);
    push @update_rects, $drect;
}

sub erase_image_from($$$$) {
    my ($image, $x, $y, $img) = @_;
    my $drect = new SDL::Rect(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    $img->blit($drect, $app, $drect);
    push @update_rects, $drect;
}

sub erase_image($$$) {
    my ($image, $x, $y) = @_;
    erase_image_from($image, $x, $y, $background);
}

sub put_image_to_background($$$) {
    my ($image, $x, $y) = @_;
    my $drect;
    ($x == 0 && $y == 0) and print "put_image_to_background: warning, X and Y are 0\n";
    if ($y > 0) {
        $drect = new SDL::Rect(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
        $display_on_app_disabled or $image->blit($rects{$image}, $app, $drect);
        $image->blit($rects{$image}, $background, $drect);
    } else {  #- clipping seems to not work when from one Surface to another Surface, so I need to do clipping by hand
        $drect = new SDL::Rect(-width => $image->width, -height => $image->height + $y, -x => $x, '-y' => 0);
        my $irect = new SDL::Rect(-width => $image->width, -height => $image->height + $y, '-y' => -$y);
        $display_on_app_disabled or $image->blit($irect, $app, $drect);
        $image->blit($irect, $background, $drect);
    }
    push @update_rects, $drect;
}

sub remove_image_from_background($$$) {
    my ($image, $x, $y) = @_;
    ($x == 0 && $y == 0) and print "remove_image_from_background: warning, X and Y are 0\n";
    my $drect = new SDL::Rect(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    $background_orig->blit($drect, $background, $drect);
    $background_orig->blit($drect, $app, $drect);
    push @update_rects, $drect;
}

sub clear_to_background(){
    my ($x1, $y1, $x2, $y2)=@_;
    my $drect = new SDL::Rect(-width => $x2-$x1, -height => $y2-$y1, -x => $x1, '-y' => $y1);
    $background_orig->blit($drect, $background, $drect);
    $background_orig->blit($drect, $app, $drect);
    push @update_rects, $drect;
}


sub load_level { # level loader

    my ($lvl)=(@_);
    my ($ret, $buf, $ln);
    my $file="$PREFIX/levelpacks/$ag->{levelpack}.pdb";

    open FH, $file or die "Levelpack ($file): $!"; while(<FH>) {$buf.=$_}; close FH; # load level pack file...
    
    my $name=$buf;  $name=~ s/\x00.*$//s;

    $ag->{levelpack}=$name;
    
    $buf=~ s/^.*?\x03Level\x00board\x00/$1/s;
    
    foreach (split /\x03Level\x00board\x00/, $buf){
	my @line=split/\//, $_;
	my ($y,$last);
		
	while ($y < 8){
	    $last=shift(@line);
	    my @c=split //, $last;
	    my ($p, $x, $row);
	    while ($x < 10){
		# not moving block
		if ($c[$p]=~ /[0-9]/) {  
		    my $ec=0;
		    if ($c[$p+1]=~ /[0-9]/){ 
			$ec=10*$c[$p] + $c[$p+1];
			$p+=2;
		    } else {		
			$ec=$c[$p];
			$p++;
		    }
		    $row.='#' x $ec;
		    $x+=$ec;
		} elsif ($c[$p]=~ /~/) { # empty space
		    $row.=' ';
		    $x++; $p++;
		} elsif ($c[$p]=~ /[a-h]/){ # specified block
		    $row.=uc( $c[$p]);
		    $x++; $p++;
		} else { # just to avoid infinite loop
		    $x++; $p++;
		}
	    }		
	    if ($ln == $lvl){
    		$ret.="$row\n";
	    }
	    $y++;
	    if ($y==8) { $last=~ s/^.*?\x00// };
	}
	my $solution=$last; $solution=~ s/^.*?solution\x00(.*?)(\x00|$).*/$1/;
	if ($lvl == $ln){
	   my $title=$last; $title=~ s/^.*?title\x00(.*?)(\x00|$).*/$1/;
	   $ag->{level_name}=$title;
	   $ag->{solution}=$solution;
	   $ag->{sol_moves}=length($solution)/2;
	   &qscroll_add("Try to solve this level!");
	   &qscroll_add("$title ($ag->{sol_moves} moves)");
	}
	$ln++;					  
   }
   return $ret;
};


