push commit from localhost

depricated/MyParser/LexerPrelim.PL

@@ -0,0 +1,209 @@
+use strict;
+use warnings;
+use feature "switch";
+use IWannaFly'Null;
+my @stack = ('error','initial');
+my @parsed;
+local $\ = undef;
+
+our %expr = (
+quote => qr/^((?<!\\)\")/ims,
+lbrack => qr/^[\s]*((?<!\\)\[)/ims,
+rbrack => qr/^[\s]*((?<!\\)\])/ims,
+lparen => qr/^[\s]*((?<!\\)\()/ims,
+rparen => qr/^[\s]*((?<!\\)\))/ims,
+semicolon => qr/^[\s]*((?<!\\);)/ims,
+string => qr/^((?!(?<!\\)\").*)/ims,
+
+our %dispatch = (
+initial => &initial,
+qstring => &string,
+mlist => &mlist,
+sexpr => &sexpr,
+fname => &fname,
+error => warn "\033[1;91mFound extra closing brace of some flavor; fatal.\033[21;22;24;0m\n"; return -1;);
+
+sub initial {
+	my $input = shift;
+	my $match;
+	again29:
+	if ($input) {
+		$match = substr $input,0,1;
+		$input = substr $input,1;
+		if ($input) {
+			if ($match cmp '(') {
+				push(@stack,'sexpr');
+				push(@stack,'fname');
+				push(@parsed,["(","("];
+				return $dispatch{@stack[-1]}->($input);
+				}
+			else {
+				warn "\033[1;91mFound garbage\033[21;22;24;0m\n";
+				goto again29;
+				}
+			}
+		else {
+			warn "\033[1;91mFound garbage near SEND\033[21;22;24;0m\n";
+			return \@parsed;
+			}
+		}
+	else {
+		return \@parsed;
+		}
+	}
+
+sub string {
+	my $input = shift;
+	my $match;
+	if ($input) {
+		$input =~ s/($expr{quote}|$expr{string})//;
+		$match = $1 ? $1 : undef;
+		if ($match) {given (substr $match,0,1) {
+			when (m/$expr{quote}/) {
+				pop(@stack);
+				push(@parsed,['"','"'];
+				}
+			default {
+				push(@parsed,["TEXT",$match];
+				}
+			}}
+		else {
+			warn "\033[1;91mFound garbage\033[21;22;24;0m\n";
+			}
+		return $dispatch{@stack[-1]}->($input);
+		}
+	else {
+		warn "\033[1;91mFound end of file before attaining balance\033[21;22;24;0m\n";
+		return -1;
+		}
+	}
+
+sub mlist {
+	my $input = shift;
+	my $match;
+	my $backtrack;
+	if ($input) {
+		$input =~ s/^[\s]*((?<!\\)[;\]];|(?!(?<!\\)[;\]]).*)//ms;
+		$match = $1 ? $1 : undef;
+		if ($match) {given (substr $match,0,1) {
+			when (m/$expr{quote}/) {
+				push(@stack,'qstring');
+				$input = (substr $match,1) . $input
+				push(@parsed,['"','"'];
+				}
+			when (m/$expr{lbrack}/) {
+				push(@stack,'mlist');
+				$backtrack = substr $match,1;
+				if ($backtrack) {
+					$input = $backtrack . $input;
+					}
+				push(@parsed,['[','['];
+				}
+			when (m/$expr{lparen}/) {
+				push(@stack,'sexpr');
+				push(@stack,'fname');
+				$backtrack = substr $match,1;
+				if ($backtrack) {
+					$input = $backtrack . $input;
+					}
+				push(@parsed,['(','('];
+				}
+			when (m/$expr{rbrack}/) {
+				pop(@stack);
+				$backtrack = substr $match,1;
+				if ($backtrack) {
+					$input = $backtrack . $input;
+					}
+				push(@parsed,[']',']'];
+				}
+			default {
+				push(@parsed,['DATA',$match]}
+			}}
+		else {
+			warn "\033[1;91mFound garbage or the empty string; programming error before __LINE__ in parser\033[21;22;24;0m\n";
+			}
+		return $dispatch{@stack[-1]}->($input);
+		}
+	else {
+		warn "\033[1;91mFound end of file before attaining balance\033[21;22;24;0m\n";
+		return -1;
+		}
+	}
+
+sub sexpr {
+	my $input = shift;
+	my $match;
+	if ($input) {
+		$input =~ s/^[\s]*([\S]*)//ms;
+		$match = $1 ? $1 : undef;
+		if ($match) {given ($match) {
+			when (m/$expr{quote}/) {
+				push(@stack,'string');
+				$input = (substr $match,1) . $input
+				push(@parsed,['"','"'];
+				}
+			when (m/$expr{lbrack}/) {
+				push(@stack,'mlist');
+				$input = (substr $match,1) . $input
+				push(@parsed,['[','['];
+				}
+			when (m/$expr{lparen}/) {
+				push(@stack,'sexpr');
+				push(@stack,'fname');
+				$input = (substr $match,1) . $input
+				push(@parsed,['(','('];
+				}
+			when (m/$expr{rparen}/) {
+				pop(@stack);
+				$input = (substr $match,1) . $input
+				push(@parsed,[')',')'];
+				}
+			default {
+				push(@parsed,['DATA',$matched];
+				}
+			}}
+		else {
+			warn "\033[1;91mFound garbage or the empty string; programming error before __LINE__ in parser\033[21;22;24;0m\n";
+			}
+		return $dispatch{@stack[-1]}->($input);
+		}
+	else {
+		warn "\033[1;91mFound end of file before attaining balance\033[21;22;24;0m\n";
+		return -1;
+		}
+	}
+
+sub fname {
+	my $input = shift;
+	my $match;
+	if ($input) {
+		$input =~ s/^[\s]*([\S]*)//ms;
+		$match = $1 ? $1 : undef;
+		if ($match) {given ($match) {
+			when (m/$expr{rparen}/) {
+				pop(@stack);
+				pop(@stack);	<!--wishlist: twice keyword-->
+				push(@parsed,[')',')'];
+				}
+			when (m/$expr{operator}/) {
+				pop(@stack);
+				push(@parsed,[$match,$match];
+				}
+			when (m/$expr{reserved}/) {
+				push(@parsed,[uc($match),uc($match)];
+				}
+			when (m/ident/) {
+				push(@parsed,['DATA',$match];
+				}
+			default {}
+			}}
+		else {
+			warn "\033[1;91mFound garbage or the empty string; programming error before __LINE__ in parser\033[21;22;24;0m\n";
+			}
+		return $dispatch{@stack[-1]}->($input);
+		}
+	else {
+		warn "\033[1;91mFound end of file before attaining balance\033[21;22;24;0m\n";
+		return -1;
+		}
+	}

depricated/MyParser/YYLval.pm

@@ -0,0 +1,10 @@
+package IWannaFly::MyParser'YYLval;
+use strict;
+use warnings;
+
+our @yylval;
+
+getval {
+	my \@pair = shift @yylval;
+	return (($pair[1] // ''),($pair[2] // undef))
+	}

depricated/MyParser/test.iwfcl

@@ -0,0 +1 @@
+(foo bar (baz [x;y;z;w] "quux") zot {xyzzy => "nothing happens",plugh => "a hollow voice says fool"})()(abracadabra NULL {the_doctor => is_in} [NIL,True,T,fAlSe,fred,'',0xFF,

depricated/MyParser/test.pl

@@ -0,0 +1,19 @@
+$DB::single = 1 or die;
+use warnings;
+use strict;
+use lib '../..';
+use IWannaFly::MyParser'Lexer;
+use IWannaFly::MyParser'YYLval;
+no Text::Balanced;
+
+open(my $fh,'<','test.iwfcl');
+my $text = <$fh>;
+chomp $text;
+IWannaFly::MyParser'Lexer::entrypoint($text);
+here: forever {
+	my ($token,$value) = IWannaFly::MyParser'YYLval::val;
+	say "$token => $value";
+	if ($token eq '') {
+		last here;
+		}
+	}		

src/ConstExtraction.PL

@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use feature "switch";
+
+open(my $file,'+>','./modules/IWannaFly/Constants.pm');
+
+printf $file <<'ETX';
+package IWannaFly::Constants;
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT;
+ETX
+say $file '#AUTOGENERATED';
+
+open(my $header,'<','./constants.h');
+
+until (eof($header)) {
+	if (<$header> =~ m/^#define ([\w]*) ([\S]*)(?:$|\t)/) {
+		my $foo = $1;
+		my $bar = $2;
+		unless ($foo =~ m/CEILING/) {
+			printf $file 'use constant C__';
+			printf $file "$foo => $bar;\n";
+			say $file 'push(@EXPORT,C__' . $foo . ');';
+			}
+		}
+	}
+close $header;
+close $file;
+__END__

src/PathExtraction.PL

@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+use feature "switch";
+
+open(my $file,'+>','./modules/IWannaFly/Paths.pm');
+
+printf $file <<'ETX';
+package IWannaFly::Paths;
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT;
+ETX
+say $file '#AUTOGENERATED';
+
+open(my $header,'<','./paths.h');
+
+until (eof($header)) {
+	if (<$header> =~ m/^#define ([\w]*) ([\S]*)(?:$|\t)/) {
+		my $foo = $1;
+		my $bar = $2;
+		$bar =~ s/(?:(?<!\\)\")/\'/g;
+		printf $file 'use constant ENV__';
+		printf $file "$foo => $bar;\n";
+		say $file 'push(@EXPORT,ENV__' . $foo . ');';
+		}
+	}
+close $header;
+close $file;
+__END__

src/constants.h

@@ -0,0 +1,63 @@
+#define NIL ""
+
+#ifndef OK
+#define OK 0
+#endif
+
+#ifndef ERR
+#define ERR -1
+#endif
+
+#define GRAV 3.2174	/*if you backtrack this to determine the size of a grid unit, you're trying to hard
+#define MAX_X 64
+#define MAX_Y 24	//MAX_X ≥ MAX_Y ≥ MAX_Z
+#define MAX_Z 16
+#define CEILING ROOM->ceiling
+#define ROOF 201	//it is decreed: mortals shall fly no higher. (this means you!)
+#define EQUATOR 360	//the number of rooms in the circumfrence of the sphere
+
+#define GOOD_MASK 0700
+#define LAWFUL_MASK 0444
+#define EVIL_MASK 0007
+#define CHAOTIC_MASK 0111
+
+#define NEUT_HORIZ_MASK 0070
+#define NEUT_VERT_MASK 0222
+
+#define LAW_GOOD_BIT 0400
+#define NEUT_GOOD_BIT 0200
+#define CHAOS_GOOD_BIT 0100
+#define LAW_NEUT_BIT 0040
+#define TRUE_NEUT_BIT 0020
+#define CHAOS_NEUT_BIT 0010
+#define LAW_EVIL_BIT 0004
+#define NEUT_EVIL_BIT 0002
+#define CHAOS_EVIL_BIT 0001
+
+#define LAW_GOOD_WIDEMSK 0764
+#define CHAOS_GOOD_WIDEMSK 0731
+#define LAW_EVIL_WIDEMSK 0467
+#define CHAOS_EVIL_WIDEMSK 0137
+#define NEUTRAL_WIDEMSK 0272
+
+#define ELE_WATER_BIT 0x80
+#define ELE_ICE_BIT 0x40
+#define ELE_AIR_BIT 0x20
+#define ELE_ELEC_BIT 0x10
+#define ELE_FIRE_BIT 0x08
+#define ELE_METAL_BIT 0x04
+#define ELE_EARTH_BIT 0x02
+#define ELE_TREE_BIT 0x01
+
+#define ELE_WATER_WIDEMSK 0xC1
+#define ELE_ICE_WIDEMSK 0xE0
+#define ELE_AIR_WIDEMSK 0x70
+#define ELE_ELEC_WIDEMSK 0x38
+#define ELE_FIRE_WIDEMSK 0x1C
+#define ELE_METAL_WIDEMSK 0x0C
+#define ELE_EARTH_WIDEMSK 0x07
+#define ELE_TREE_WIDEMSK 0x83
+
+#define LIGHT_BIT 04
+#define DARK_BIT 02
+#define ENTROPY_BIT 01

src/events/lawful_plane_guardian_battle.pseudo

@@ -0,0 +1,12 @@
+#define NACHOS sprintf("That sword does not belong to you...")
+
+if ((PLAYER->weap_left.type == LEGEND_FLAG) &&
+	!strcmp(legendstabs[PLAYER->weap_left.data->metadata],
+	"sword of justice") {
+		free(PLAYER->weap_left.data);
+		PLAYER->weap_left.data = NULL;
+		NACHOS;
+else if ((PLAYER->weap_right.type == WEAP_FLAG) && ...
+else for (iterate iventory yadda yadda yadda...)
+//etc etc etc
+some_func_summon_justice();

src/greedy/README.md

@@ -0,0 +1 @@
+I will probably throw Ada at this at some future date.

src/greedy/greedy.messy

@@ -223,7 +223,7 @@ ushort mask[16]
 {
 uchar row = (tile | 0xF0) >> 4
 ushort column
-switch (tile|0x0F) : {
+switch (tile&0x0F) : {
 	case 0x00 : column = 0x8000; break;
 	case 0x01 : column = 0x4000; break;
 	case 0x02 : column = 0x2000; break;