123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427 |
- 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;
|