avgdl_perl/src/structure.pl

use strict;
use warnings;

# whitespace
my $WS = " 	\n";

# game structure object :
# % structures : hash containing all the structures in the file
# 	each structure is an array with all its data
# @ pointers_stack : stack of arrays containing all the pointers inside the structures
# 	the last array in the stack, is the current array
# 	the last pointer in the array is the current pointer
# 	pointer format: [ "struct_name", index ]

# reads the `structure` file and returns its elements one-by-one

# TODO - remove
my @counters;
my $counter;
my %struct = ();

# opens file
sub game_structure_open {

	# get structure filename and open it
	my $filename = shift;
	open(my $in, "<", $filename) or die "structure: $filename: $!";

	# structure object to return
	my $game_structure = {};

	# contains the last created structure, any new element is part of this struct
	my $last_struct;

	# count characters in each line, in case of error
	my $line_chars;
	my $current_char;

	# parse line-by-line
	while (<$in>) {

		# get total line characters and set current character to first character
		$line_chars = length;
		$current_char = 1;

		# parse until line is empty
		while (length > 0) {

			# each iteration should parse at least 1 character
			# calculate current character and amount of characters left
			$current_char += $line_chars -length;
			$line_chars = length;

			# whitespace found - remove it
			if (/^[$WS]+/) {
				s/^[$WS]+//;
			}
			# new structure found - add it to the object
			elsif (/^\./) {

				# get name
				s/^\.([^$WS]+)//;

				# create new structure of data
				$last_struct = [];

				# save structure to object
				$game_structure->{"structures"}{$1} = $last_struct;

			}
			# strings
			elsif (/^\^/) {

				# remove string
				s/^(\^)//;

				# add it to array - default at 1 quantity
				push @$last_struct, [$1, 1];

			}
			# numbers
			elsif (/^\$/) {

				# remove number symbol
				s/^(\$)//;

				# add it to array
				push @$last_struct, [$1, 1];

			}
			# another structure
			elsif (/^@/) {

				# remove structure symbol and its name
				s/^(@[a-zA-Z]+)//;

				# oush it to array
				push @$last_struct, [$1, 1];

			}
			# quantity
			elsif (/^[0-9~]+/) {

				# remove quantity
				s/^([0-9~]+)//;

				# add it on the last element of structure
				# (on block number 1 which holds quantity)
				my $size = @$last_struct -1;
				$last_struct->[$size][1] = $1;

			}
			# ignore comments
			elsif (/^#/) {

				# remove comment from input
				s/^(#.*$)//;

			}
			# unable to parse symbol - exit with error
			else {

				# get next symbol only, show error and exit
				s/^(.)//;
				print("open_structure: cannot parse '$1' on $filename:$.:$current_char\n");
				return;

			}

		} # while length

	} # while lines

	# initialize pointers
	game_structure_init_pointers($game_structure);

	# return game structure
	return $game_structure;

} # open structure

# initialize pointers
# can be called on a new or already existing game structure
# to reset its pointers from the beginning
sub game_structure_init_pointers {

	# get game structure
	my $game_structure = shift;

	# reset its pointers with the initial one
	$game_structure->{"pointers_stack"} = [];
	push @{$game_structure->{"pointers_stack"}}, [["game", 0]];

} # game structure init pointers

# get last pointer array on the stack
sub get_last_pointer_array {
	my $game_structure = shift;
	return $game_structure->{"pointers_stack"}[ @{ $game_structure->{"pointers_stack"} } -1 ];
}

# push pointer array to stack
sub push_pointer_array {
	my $game_structure = shift;
	my $pointers = get_last_pointer_array($game_structure);

	my $ar = [];
	foreach (@$pointers) {
		push @$ar, [ $_->[0], $_->[1] ];
	}

	push @{$game_structure->{"pointers_stack"}}, $ar;
} # push structure

# pop pointer array from stack
sub pop_pointer_array {
	my $game_structure = shift;
	pop @{ $game_structure->{"pointers_stack"} };
} # pop pointer array

# return the next element based on last pointer (format [$element, $quantity])
sub next_element {

	# get game structure and its data
	my $game_structure = shift;
	my $pointers = get_last_pointer_array($game_structure);#->{"pointers_stack"};
	my $structures = $game_structure->{"structures"};

	# no more pointers == reached EOG (end of game)
	if (@$pointers == 0) {
		return "EOG";
	}

	# get current pointer data
	my $c_pointer = $pointers->[@$pointers -1];
	my $pointer_point = $c_pointer->[1];

	# pointed structure data
	my $pointed_struct = $structures->{$c_pointer->[0]};
	my $pointed_struct_size = @$pointed_struct +0;

	# reached EOS (end of struct)
	if ($pointer_point >= $pointed_struct_size) {
		# remove current counter
		pop @$pointers;
		return "EOS";
	}

	# find element pointed by pointer (format: [element, quantity])
	my $element = $pointed_struct->[$pointer_point];
	my $element_type = $element->[0];
	my $element_quantity = $element->[1];

	# new struct - create new counter
	if ($element_type =~ /^@([a-zA-Z]+)/) {
		push @$pointers, [$1, 0];
	}

	# move to next element
	$c_pointer->[1]++;

	# return element
	return $element;

} # next element [$element, $quantity]

# checks if game data reflects structure data
sub check_data {

	# game data
	my $data = shift;
	my $game_structure = shift;
	my $data_counter = 0;

	# process elements until structure reaches the end
	while ( (my $c_element = next_element($game_structure)) ne "EOG" ) {

		# found End Of Structure, stop parsing
		if ($c_element eq "EOS") {
			# successfully parsed this structure
			return 1;
		}

		# expecting more data, but data array has no more
		if ($data_counter >= @$data) {
			printf("EXPECTING MORE DATA, BUT NOOOOO\n");
			last;
		}

		# get current element data
		my $expect_type = $c_element->[0];
		my $expect_quantity = $c_element->[1];
		#printf("expecting $expect_type : $expect_quantity\n");

		# next variable in data is a single variable
		if ($expect_quantity eq "1") {

			# expecting more data, but data array has no more
			if ($data_counter >= @$data) {
				printf("EXPECTING MORE DATA, BUT NOOOOO\n");
				last;
			}

			# expecting a new structure
			if ($expect_type =~ /^@/) {

				my $sub_struct = $data->[$data_counter];
				if (ref $sub_struct ne ref []) {
					printf("was expecting an array of data, instead got $sub_struct\n");
					last;
				}

				#printf("~~~ time to parse a structure ~~~\n\n");
				if (!check_data($sub_struct, $game_structure)) {
					printf("error parsing sub-structure!\n");
					last;
				}
				#printf("~~~ sub-structure read successfuly ~~~\n");
			}
			# expect number or string
			elsif ($expect_type =~ /^[\$\^]/) {
				# game data values
				my $data_type = $data->[$data_counter][0];
				my $data_value = $data->[$data_counter][1];

				#printf("found $data_type : $data_value\n");
				if ($expect_type eq $data_type) {
					#printf("fits\n");
				}
				else {
					printf("doesn't fit\n");
					last;
				}
			}
			# expecting unrecognized data
			else {
				printf("cannot parse $expect_type : $expect_quantity\n");
				last;
			}

			#printf("\n");
			$data_counter++;

		}
		# next variable in data is an array of variables
		elsif ($expect_quantity eq "~" || $expect_quantity >= 1) {

			# get array of data
			my $ar = $data->[$data_counter];

			# counter
			my $i = 0;

			# ~ array
			if ($expect_quantity eq "~") {

				#printf("parsing ~ array\n");
				while ($ar->[$i] ne "~") {

					# structure
					if ($expect_type =~ /^@/) {

						# check if last element
						my $is_last = 0;
						if ($i+1 >= @$ar or $ar->[$i+1] eq "~") {
							$is_last = 1;
						}

						if (!$is_last) {
							push_pointer_array($game_structure);
						}
						#printf("~~~ parse struct ~~~\n");
	
						my $ar2 = $ar->[$i];
	
						if (!check_data($ar2, $game_structure)) {
							printf("struct data is wrong\n");
						}
	
						#printf("~~~ done ~~~\n");
						if (!$is_last) {
							pop_pointer_array($game_structure);
						}

						if ($is_last) {
							#printf("last ~ element\n");
						}

					}
					# number/string
					else {

						my $type = $ar->[$i][0];
						my $value = $ar->[$i][1];
						#printf("array type: $type\n");
						#printf("array value: $value\n");
	
						if ($type ne $expect_type) {
							printf("something in the ~ array is wrong\n");
							return 0;
						}

					}

					$i++;

				} # while not ~

			} # ~ array
			# numbered array
			else {

				while ($i < $expect_quantity) {

					if ($expect_type =~ /^@/) {

						my $is_last = 0;

						if ($i+1 >= $expect_quantity) {
							$is_last = 1;
						}

						if (!$is_last) {
							push_pointer_array($game_structure);
						}
						#printf("~~~ array of structs ~~~\n");
						my $ar2 = $ar->[$i];

						if (!check_data($ar2, $game_structure)) {
							printf("struct data is wrong\n");
						}
						#printf("~~~ done ~~~\n");
						if (!$is_last) {
							pop_pointer_array($game_structure);
						}
					}
					else {

						my $type = $ar->[$i][0];
						my $value = $ar->[$i][1];
	
						if ($type ne $expect_type) {
							printf("something in the array is wrong\n");
							return 0;
						}
	
					}

					$i++;
				}

			}

			$data_counter++;

		}

	}

	# something failed
	return 0;
}


# everything is ok
return 1;