diff --git a/depricated/MyParser/Lexer.pm b/depricated/MyParser/Lexer.pm new file mode 100644 index 0000000..44998b4 --- /dev/null +++ b/depricated/MyParser/Lexer.pm @@ -0,0 +1,771 @@ +package MyParser::Lexer; +use strict; +use warnings; + +###################################################################### +#NOTICE +# +#gotos are used instead of subroutines since no distinction is made +#between blocks and scopes; this oversight makes the use of goto +#in this manner a necessity for non-linear programming, since +#variables would otherwise be shell-gamed in ungood ways. +# +#the gotos can be thought of as functions/subroutines which take +#the current state as an argument and return sideffects, +# +#using a flowchart with the entrypoint at the top, the drain at +#the bottom, all the tier 1 dispatchers on one side, all the +#tier 2 sorters on the opposite, and the whitespace/unary filter as +#a large vertical bar between the two columns, with all permutations +#of possible flow transfer shown, would provide the best understanding +#of the program's structure. +# +#yes, you can have structure with gotos, and excluding or "safing" +#them introduces an artificial ceiling to a program's complexity and +#efficiancy, one that I hit hard before making this design choice. +###################################################################### + +sub prompt { + printf "\033[1;4;95m>\033[96m>\033[97m>\033[21;22;24;0m"; + my $tmp = ; + chomp $tmp; + return $tmp; + } + +our $WHITESPACE = qr/[\0\a\s\034-\037]/ms; + +our $UNSIGNED = qr/(?:0[xb])?(?:[0]*[1-9][0-9]*)/i; +our $FLOAT = qr/?[0-9]*[\.][0-9]+/ +our $RNG = qr/(?:$UNSIGNED(?:ran)?[d]$UNSIGNED)/i +our $BONUS = qr/(?:+|±)$UNSIGNED/ +our $NUMBER = qr/(?:$INTERGER|$FLOAT|$RNG|$BONUS)/ + +our $QTEXT = qr/^((?:(?!(?|(?:\-\>)?(?:\{(?:(?R))\}|\[(?:(?R)|[\-]?[0-9]+|[\#])\]))*))|$SIGAL(?:[^\w\s]|[\^]A-Z]|[\+\-])(?:\[(?:[\-]?[0-9]+|[\#])\]?))/; +our $READ = qr/[\<](?:[\w]+|$NAME)[\>]/; + +our $SYMBOL = qr/^(?:(?:[\<](?:[\<]|[\=][\>]?)?|[\=][\~\=]?|[\+\-\%\~\!\|\&\>][\=]?|[\/](?:[\/\=])?|[\>][\>]|[\|][\|]|[\&][\&]|×|÷|≤|≥)|N[PC]R|[N]?AND|[X]?[N]?OR|NOT|[LG][TE]|NE|EQ(?:UAL)?|IFF|CMP|COINFLIP|FLIP[A]?COIN|MOV[E]?)/ims; +our $PREFIX = qr/^(?:(?:[!~]|[\+][\+]|[\-][\->]?)(?>!$WHITESPACE))/ +our $POSTFIX = qr/^(?:(?!(?[-1]); + } + unless ($input eq '') { + if ($match eq '(') {goto lparen;} + else {die "syntax error outdoors at character $col (±dodgy counters)";} + } + else {die "syntax error outdoors near EOF";} + } +else {goto drain;} +###################################################################### +#ENTRYPOINT +die qq{fell out of bounds and eaten by a goto raptor; +(tier: -1, section: } . $stack->[-1] . ')'; +#UNARY / WHITESPACE +###################################################################### +nomnom: +unless ($input eq '') { + $input =~ s/^($WHITESPACE*(?:$PREFIX)?|$POSTFIX$WHITESPACE+)//; + $match = $1 // die "syntax error in s-expression at character $col (±dodgy counters); garbage"; + $col += length $match; + unless ($input eq '') { + unless ($match eq '') { + given (substr $match,0,1) { + when ($match eq '+') {push @yylval,['POST','++'];} + when ($match eq '-') {push @yylval,['POST','--'];} + when ($match eq '!') {push @yylval,['FACT'];} + default {given (substr $match,-1,1) { + when ($match eq '+') {push @yylval,['PRE','++'];} + when ($match eq '-') { + if ((substr $match,-2,1) eq '-') { + push @yylval,['PRE','--']; + } + else { + push @yylval,['NEGATIVE']; + } + when ($match eq '!') {push @yylval,['NOT'];} + when ($match eq '~') {push @yylval,['BITNOT'];} + when ($match eq '>') {push @yylval,['PTR'];} + default {} + } + } + goto ($stack->[-1]); + } + } + } +###################################################################### +#UNARY / WHITESPACE +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 0, section: } . $stack->[-1] . ')'; +#TIER 1 +###################################################################### +s_expr: +unless ($input eq '') { + $input =~ s/($NUMBER|$NAME|//; + $match = $1 // die "syntax error in s-expression at character $col (±dodgy counters); garbage"; + $col += length $match; + unless ($input eq '') { + unless ($match eq '') { + if ($match =~ m/$NUMBER/) {goto parsenumber;} + given (substr $match,0,1) { + when ($_ =~ m/$SIGAL/) {push @yylval,['VAR',$match];} + when ($_ =~ m/N/) {goto disambig_n;} + when ($_ =~ m/t/i) {goto disambig_t;} + when ($_ =~ m/f/i) {goto disambig_f;} + when ($_ eq '(') {goto lparen;} + when ($_ eq ')') { + pop @stack; + push @yylval,[')']; + goto ($stack->[-1]); + } + when ($_ eq '{') + + } + when ($_ eq '}') { + die "syntax error in s-expression at character $col (±dodgy counters); '}' is not a valid closing character"; + } + when ($_ eq '[') { + + } + when ($_ eq ']') { + die "syntax error in s-expression at character $col (±dodgy counters); ']' is not a valid closing character"; + } + when ($_ eq "'") { + unless ((substr $input,0,1) eq "'") { + push @stack,'qstring' + push @yylval,["'"]; + goto ($stack->[-1]); + } + else { + $input = substr $input,1; + $col++; + push @yylval,['DATA','']; + } + } + when ($_ eq '"') { + unless ((substr $input,0,1) eq '"') { + push @stack,'qqstring' + push @yylval,['"']; + goto ($stack->[-1]); + } + else { + $input = substr $input,1; + $col++; + push @yylval,['DATA','']; + } + } + when ($_ eq ',') { + unless ((substr $input,0,1) =~ m/[,;]/) { + push @yylval,[',']; + goto ($stack->[-1]); + } + else { + push @yylval,[',']; + push @yylval,['DATA',0]; + } + } + when ($_ eq ';') { + unless ((substr $input,0,1) =~ m/[,;]/) { + push @yylval,[';']; + goto ($stack->[-1]); + } + else { + push @yylval,[';']; + push @yylval,['DATA',0]; + } + } + default { + push @yylval,['DATA',$match]; + } + } + goto ($stack->[-1]) + } + else { + die "syntax error in s-expression at character $col (±dodgy counters)" + } + } + else { + die "syntax error in s-expression near EOF"; + } + } +else { + die "syntax error in s-expression at EOF"; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 1, section: } . $stack->[-1] . ')'; +###################################################################### +m_list: +unless ($input eq '') { + $input =~ s/$M_LIST//; + $match = $1 // die "syntax error in m-list at character $col (±dodgy counters); found garbage"; + $col += length $match; + unless ($input eq '') { + unless ($match eq '') { + if ($match =~ m/$NUMBER/) { + goto parsenumber; + } + given (substr $match,0,1) { + when ($_ =~ m/$SIGAL/) {push @yylval,['VAR',$match];} + when ($_ eq 'N') {goto disambig_n;} + when ($_ =~ m/t/i) {goto disambig_t;} + when ($_ =~ m/f/i) { + if (uc($match) eq "FALSE") { + push @yylval,['VAR',uc($match)]; + } + else { + push @yylval,['DATA',$match]; + } + when ($_ eq '(') { + unless ((substr $input,0,1) eq ')') { + push @stack,'s_expr' + push @yylval,['(']; + } + else { + $input = substr $input,1; + $col++; + } + } + when ($_ eq ')') { + die "syntax error in m-list at character $col (±dodgy counters); ')' is not a valid closing character"; + } + when ($_ eq '{') + unless ((substr $input,0,1) eq '}') { + push @stack,'struct_key' + push @yylval,['[']; + } + else { + $input = substr $input,1; + $col++; + push @yylval,['DATA',NULL]; + } + } + when ($_ eq '}') { + die "syntax error in m-list at character $col (±dodgy counters); '}' is not a valid closing character"; + } + when ($_ eq '[') { + unless ((substr $input,0,1) eq ']') { + push @stack,'m_list' + push @yylval,['[']; + } + else { + $input = substr $input,1; + $col++; + push @yylval,['DATA','']; + } + } + when ($_ eq ']') { + pop @stack; + push @yylval,[']']; + goto ($stack->[-1]) + } + when ($_ eq "'") { + unless ((substr $input,0,1) eq "'") { + push @stack,'qstring' + push @yylval,["'"]; + } + else { + $input = substr $input,1; + $col++; + push @yylval,['DATA','']; + } + } + when ($_ eq '"') { + unless ((substr $input,0,1) eq '"') { + push @stack,'qqstring' + push @yylval,['"']; + } + else { + $input = substr $input,1; + $col++; + push @yylval,['DATA','']; + } + } + when ($_ eq ',') { + unless ((substr $input,0,1) =~ m/[,;]/) { + push @yylval,[',']; + } + else { + push @yylval,[',']; + push @yylval,['DATA',NULL]; + } + } + when ($_ eq ';') { + unless ((substr $input,0,1) =~ m/[,;]/) { + push @yylval,[';']; + } + else { + push @yylval,[';']; + push @yylval,['DATA',NULL]; + } + } + default { + push @yylval,['DATA',$match]; + } + } + goto ($stack->[-1]) + } + else { + die "syntax error in m-list at character $col (±dodgy counters)" + } + } + else { + die "syntax error in m-list near EOF"; + } + } +else { + die "syntax error in m-list at EOF"; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 1, section: } . $stack->[-1] . ')'; +###################################################################### +struct_val: +unless ($input eq '') { + $input =~ s/$VALUE//; + $match = $1 // die "syntax error in struct value at character $col (±dodgy counters); found garbage"; + $col += length $match; + unless ($input eq '') { + unless ($match eq '') { + if ($match =~ m/$NUMBER/) { + goto parsenumber; + } + given (substr $match,0,1) { + when ($_ =~ m/$SIGAL/) { + pop @stack; + push @stack,'struct_sep'; + push @yylval,['VAR',$match]; + } + when ($_ eq 'N') { + if ($match eq "NULL") { + push @yylval,['VAR',$match]; + } + elsif ($match eq "NIL") { + push @yylval,['VAR',$match]; + } + else { + push @yylval,['DATA',$match]; + } + when ($_ =~ m/t/i) { + if (($match eq 'T') || (uc($match) eq "TRUE")) { + push @yylval,['VAR',uc($match)]; + } + else { + push @yylval,['DATA',$match]; + } + when ($_ =~ m/f/i) { + if (uc($match) eq "FALSE") { + push @yylval,['VAR',uc($match)]; + } + else { + push @yylval,['DATA',$match]; + } + when ($_ eq '(') { + unless ((substr $input,0,1) eq ')') { + pop @stack; + push @stack,'struct_sep'; + push @stack,'s_expr'; + push @yylval,['(']; + } + else { + pop @stack; + push @stack,'struct_sep'; + $input = substr $input,1; + $col++; + push @yylval,['DATA',OK]; + } + } + when ($_ eq ')') { + die "syntax error in struct value at character $col (±dodgy counters); ')' is not a valid closing character"; + } + when ($_ eq '{') + unless ((substr $input,0,1) eq '}') { + pop @stack; + push @stack,'struct_sep'; + push @stack,'struct_key' + push @yylval,['[']; + } + else { + pop @stack; + push @stack,'struct_sep'; + $input = substr $input,1; + $col++; + push @yylval,['DATA',NULL]; + } + } + when ($_ eq '}') { + pop @stack; + push @yylval,['}']; + } + when ($_ eq '[') { + unless ((substr $input,0,1) eq ']') { + pop @stack; + push @stack,'struct_sep'; + push @stack,'m_list' + push @yylval,['[']; + } + else { + pop @stack; + push @stack,'struct_sep'; + $input = substr $input,1; + $col++; + push @yylval,['DATA',NIL]; + } + } + when ($_ eq ']') { + die "syntax error in struct value at character $col (±dodgy counters); ']' is not a valid closing character" + } + when ($_ eq "'") { + unless ((substr $input,0,1) eq "'") { + pop @stack; + push @stack,'struct_sep'; + push @stack,'qstring' + push @yylval,['"']; + } + else { + pop @stack; + push @stack,'struct_sep'; + $input = substr $input,1; + $col++; + push @yylval,['DATA',NIL]; + } + } + when ($_ eq '"') { + unless ((substr $input,0,1) eq '"') { + pop @stack; + push @stack,'struct_sep'; + push @stack,'qqstring' + push @yylval,['"']; + } + else { + pop @stack; + push @stack,'struct_sep'; + $input = substr $input,1; + $col++; + push @yylval,['DATA',NIL]; + } + } + when ($_ eq ',') { + unless ((substr $input,0,1) =~ m/[,;]/) { + pop @stack; + push @stack,'struct_key'; + push @yylval,[',']; + } + else { + $col++ + die "syntax error in struct key at character $col (±dodgy counters), key can't be nil" + } + } + goto ($stack->[-1]) + } + else { + die "syntax error in struct value at character $col (±dodgy counters)" + } + } + else { + die "syntax error in struct value near EOF"; + } + } +else { + die "syntax error in struct value at EOF"; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 1, section: } . $stack->[-1] . ')'; +###################################################################### +struct_key: +unless ($input eq NIL) { + $input =~ s/$KEY//; + $match = $1 // die "syntax error in struct key at character $col (±dodgy counters); Not a valid key sequence"; + $col += length $match; + unless ($input eq NIL) { + given (substr $match,0,1) { + when ($_ =~ m/$SIGAL/) { + pop @stack; + push @stack,'struct_val'; + push @yylval,['VAR',$match]; + push @yylval,['=>']; + } + when ($_ eq 'N') { + if ($match eq "NULL") { + die "syntax error in struct key at character $col (±dodgy counters), key can't be the NULL pointer"; + } + elsif ($match eq "NIL") { + die "syntax error in struct key at character $col (±dodgy counters), key can't literally be NIL"; + } + else { + pop @stack; + push @stack,'struct_val'; + push @yylval,['DATA',$match]; + push @yylval,['=>']; + } + when ($_ =~ m/t/i) { + if (($match eq 'T') || (uc($match) eq "TRUE")) { + die "syntax error in struct key at character $col (±dodgy counters), key can't be true, it can't handle the truth!"; + } + else { + pop @stack; + push @stack,'struct_val'; + push @yylval,['DATA',$match]; + push @yylval,['=>']; + } + when ($_ =~ m/f/i) { + if (uc($match) eq "FALSE") { + die "syntax error in struct key at character $col (±dodgy counters), key can't be false, it must be valid"; + } + else { + pop @stack; + push @stack,'struct_val'; + push @yylval,['DATA',$match]; + push @yylval,['=>']; + } + when ($_ eq '(') { + unless ((substr $input,0,1) eq ')') { + pop @stack; + push @stack,'struct_delim'; + push @stack,'s_expr'; + push @yylval,['(']; + } + else { + die "syntax error in struct key at character $col (±dodgy counters), key can't be the skip operation"; + } + } + default { + pop @stack; + push @stack,'struct_val'; + push @yylval,['DATA',$match]; + } + } + goto ($stack->[-1]); + } + else { + die "syntax error in struct key near EOF"; + } + } +else { + die "syntax error in struct key at EOF"; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 1, section: } . $stack->[-1] . ')'; +###################################################################### +hash_delim: +pop @stack; +push @stack,'struct_val'; +push @yylval,['=>']; +goto ($stack->[-1]); +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 1½, section: } . $stack->[-1] . ')'; +###################################################################### +seperator: +pop @stack; +push @stack,'struct_val'; +push @yylval,['=>']; +goto ($stack->[-1]); +###################################################################### +#TIER 1 +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 1½, section: } . $stack->[-1] . ')'; +#TIER 2 +###################################################################### +qqstring: +unless ($input eq NIL) { + $input =~ s/$QQTEXT//; + $match = $1 // die "lexer is illiterate"; + $col += length $match; + unless ($input eq NIL) { + given (substr $match,0,1) { + when ($_ =~ m/$SIGAL/) { + push @yylval,['VAR',$match]; + } + when ($_ eq '"') { + pop @stack; + push @yylval,['"']; + default { + push @yylval,['DATA',$match]; + } + } + goto ($stack->[-1]); + } + else { + die "syntax error in string near EOF"; + } + } +else { + die "syntax error in string at EOF"; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +qstring: +unless ($input eq NIL) { + $input =~ s/$QTEXT//; + $match = $1 // die "lexer is illiterate"; + $col += length $match; + unless ($input eq NIL) { + given (substr $match,0,1) { + when ($_ eq "'") { + pop @stack; + push @yylval,["'"]; + default { + push @yylval,['TEXT',$match]; + } + } + goto ($stack->[-1]); + } + else { + die "syntax error in exact string near EOF"; + } + } +else { + die "syntax error in exact string at EOF"; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +parsenumber: +if ($match =~ m/([Rr][Aa][Nn][Dd])/) { + $match = oct($match); + } +if ($match =~ m/([Dd])/) { + $match = oct($match); + } +elif ($match,0,1 eq '0') { + $match = oct($match); + } +else { + $match = $match + 0; + } +push @yylval,['NUM',$match]; +$interger = NULL; +goto ($stack->[-1]); +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +disambig_n: +if ($match eq "NULL") { +push @yylval,['VAR',$match]; + } +elsif ($match eq "NIL") { +push @yylval,['VAR',$match]; + } +else { +push @yylval,['DATA',$match]; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +disambig_t: +if (($match eq 'T') || (uc($match) eq "TRUE")) { + push @yylval,['VAR',uc($match)]; + } +else { + push @yylval,['DATA',$match]; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +disambig_f: +if (uc($match) eq "FALSE") { + push @yylval,['VAR',uc($match)]; + } +else { + push @yylval,['DATA',$match]; + } +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +lparen_tok: +if (substr $input,0,9 eq '(void*)0)' { + $input = substr $input,9; + push @yylval,['VAR','((void*)0)']; + } +else { + unless (substr $input,0,1) eq ')') { + $input = substr $input,1; + $col++; + } + else { + push @stack,'s_expr'; + push @yylval,['(']; + } + } +goto nomnom; +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +lcurly_tok: +unless ((substr $input,0,1) eq '}') { + push @stack,'hash_key' + push @yylval,['{']; + } +else { + $input = substr $input,1; + $col++; + push @yylval,['DATA',NULL]; + } +goto nomnom; +###################################################################### +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +###################################################################### +lbrack_tok: +unless ((substr $input,0,1) eq ']') { + push @stack,'array' + push @yylval,['[']; + } +else { + $input = substr $input,1; + $col++; + push @yylval,['DATA','']; + } +goto nomnom; +###################################################################### +#TIER 2 +die qq{fell out of bounds and eaten by a goto raptor; +(tier: 2, section: } . $stack->[-1] . ')'; +#DRAIN +###################################################################### +drain: +return @yylval; +} + diff --git a/depricated/MyParser/LexerPrelim.PL b/depricated/MyParser/LexerPrelim.PL new file mode 100644 index 0000000..924cacf --- /dev/null +++ b/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/^((? qr/^[\s]*((? qr/^[\s]*((? qr/^[\s]*((? qr/^[\s]*((? qr/^[\s]*((? qr/^((?!(? &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]*((?($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); + 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; + } + } diff --git a/depricated/MyParser/YYLval.pm b/depricated/MyParser/YYLval.pm new file mode 100644 index 0000000..abf79c5 --- /dev/null +++ b/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)) + } diff --git a/depricated/MyParser/test.iwfcl b/depricated/MyParser/test.iwfcl new file mode 100644 index 0000000..52aa36d --- /dev/null +++ b/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, \ No newline at end of file diff --git a/depricated/MyParser/test.pl b/depricated/MyParser/test.pl new file mode 100644 index 0000000..3d1baa8 --- /dev/null +++ b/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; + } + } diff --git a/src/modules/IWannaFly/Types/Struct/classtyp/XSLIB/classtyp.xs b/depricated/Types/Struct/classtyp/XSLIB/classtyp.xs similarity index 100% rename from src/modules/IWannaFly/Types/Struct/classtyp/XSLIB/classtyp.xs rename to depricated/Types/Struct/classtyp/XSLIB/classtyp.xs diff --git a/src/modules/IWannaFly/Types/Struct/classtyp/classtyp.pm b/depricated/Types/Struct/classtyp/classtyp.pm similarity index 100% rename from src/modules/IWannaFly/Types/Struct/classtyp/classtyp.pm rename to depricated/Types/Struct/classtyp/classtyp.pm diff --git a/src/ConstExtraction.PL b/src/ConstExtraction.PL new file mode 100644 index 0000000..b94d1e4 --- /dev/null +++ b/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__ diff --git a/src/PathExtraction.PL b/src/PathExtraction.PL new file mode 100644 index 0000000..5c34b57 --- /dev/null +++ b/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/(?:(? $bar;\n"; + say $file 'push(@EXPORT,ENV__' . $foo . ');'; + } + } +close $header; +close $file; +__END__ diff --git a/src/constants.h b/src/constants.h new file mode 100644 index 0000000..9ceffb0 --- /dev/null +++ b/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 diff --git a/src/events/lawful_plane_guardian_battle.pseudo b/src/events/lawful_plane_guardian_battle.pseudo new file mode 100644 index 0000000..455aec6 --- /dev/null +++ b/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(); diff --git a/src/greedy/README.md b/src/greedy/README.md new file mode 100644 index 0000000..77057e0 --- /dev/null +++ b/src/greedy/README.md @@ -0,0 +1 @@ +I will probably throw Ada at this at some future date. diff --git a/src/greedy/greedy.messy b/src/greedy/greedy.messy index cf39a62..181615a 100644 --- a/src/greedy/greedy.messy +++ b/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; diff --git a/src/iwannaflycurses.messy b/src/iwannaflycurses.messy index c071037..79f5c47 100644 --- a/src/iwannaflycurses.messy +++ b/src/iwannaflycurses.messy @@ -1,4 +1,4 @@ -#error NOT READY FOR COMPILATION +#error NOT READY FOR INITIAL COMPILATION /* to preserve the file history, * this file will eventually become main.h, main.c, or util.c * a dummy.h and dummy.c will provide externs and macros for linkage. @@ -29,23 +29,27 @@ * other documentation, as well as give a deeper understanding of the * program because, ya'know, source code. * - * The engine provides the C libraries and Perl modules needed to write a game. + * The engine provides the C libraries and Perl modules/scripts needed to write a game. * * a game using the engine should provide the following: * - A newgame initializer perl script - * - Any Guile extensions and shared resources needed by events + * - Any shared resources needed by events * the resource files MUST follow the following naming conventions: + * - .pl for a perl script + * - .pm for a perl module + * - .so for a shared object * - .hex or .hex## for packed unsigned byte arrays, where ## is a power of 8 * - .bin or .bin## for packed signed byte arrays, where ## is a power of 8 + * - .r8 for a room's tilemap * - .dat for the custom data format + * - .json for a JSON file + * - .pl.dump for a Data::Dumper file * - .tsv or .tab for tab seperated values * - .csv for comma seperated values * - .asc for a plaintext line-seperated record * - .txt for a plaintext block of text * - .ans for an ansi escaped line-seperated record * - .nfo for an ansi escaped block of text - * - Guile extensions to generate rooms - * - Shared resources used by events * * enviromental requirements: * - UTF-8 terminal of at least 24*80 characters @@ -65,27 +69,35 @@ * not just for other QWERTY layouts, but also for QWERTZ, AZERTY, * and Dvorak, by request and/or the ability to remap keys * by dotfiles.) - * - Mouse (once pseudo-raycasting is implemented for looking afar) * * XTerm is the recommended X Terminal Emulator (the primary one used in testing), * but the raw TTY Console set up in UTF8 locale will work just as well, * maybe even better if memory is an issue. At first glance, A Vt241 or Vt3*0 - * seem to meet all the requirements, but note: they predate unicode. + * seem to meet all the requirements, but note: they predate the invention of unicode. * * Controls: * - number keys move in xy - * - arrow keys move in x or y + * - + or - followed by a number move in xyz * - < and > move in z - * - page up or page down, followed by a direction, move in xyz - * - home starts flying - * - end stops flying + * - arrow keys, page up, and page down render a flat orthographic projection looking in that direction (free action) + * When in multiview mode: + * only visable tiles are rendered, other tiles are skipped instead of rendered blinky. + * - number keys are indexed to camera, i.e. if facing west, 8 moves west and 2 moves east. + * - F5 moves the near cullplane just in front of the player (free action) + * - : look at a tile. + * - home renders a top-down perspective at a -45 degree angle from the z axis, + * culling the first layer which obstructs the player from view and above (free action) + * - end renders only the plane including the player (free action) * - spacebar or 5 idle - * - ! shows or hides sense trouble + * - F1 shows or hides sense trouble. (free action) + * - F2 shows or hides sense alignment. (free action) + * - F3 shows or hides see invisible. (free action) + * - F4 moves the near cull plane just behind or above the player. (free action) * - . pick up items - * - \ initiates the command console + * - \ initiates command entry. free action itself, but most commands are not. * more tbd * - * new saved worlds will be generated by a seperate program. + * new saved worlds will be generated by a perl script, calling the system's tar near the end of execution. * * depending on RAM or Disk usage of the final program, it may be necissary * to run early versions in the system console to prevent resource starvation, @@ -93,6 +105,8 @@ * if such requirements arise, they will be considered a severe flaw and work * will focus on fixing them as soon as possible. * + * commands are implemented by Perl::Safe + * * This program is divided into 3 layers: * * the API layer is the part that provides functions to help with events. @@ -114,6 +128,8 @@ * promptload() * engineloop() * + * autogeneration of newgame initializers is pending; mainly because no newgame initializer exists to model one off yet. + * * the middle layer, or the guts, is where the engine actually happens, and * it isn't pretty. if you want to change how the game works, * it's going to get messy. this is where the functions for @@ -137,17 +153,7 @@ * compression libraries of the build enviroment are changed from expectations, * but is a good start. * - * an extension language interpreter will be provided - * for the API, implemented using flex/byacc; one might use the - * Generic C Preprocessor or M4 to aid in writing stand-alone - * plugins, but these are not built into the language itself - * and are not avalible on the CLI as a result - * - * an runcontrol-file interpreter will be writen this way as well, - * to be used by the new savefile generator. it will have syntax - * inspired by .nethackrc - * - * lastly, a nonstructured language will be provided for defining midi streams + * a nonstructured language will be provided for defining midi streams * in a human readable format. * * At some point in the far future, once the engine has reached Beta, @@ -155,7 +161,8 @@ * the X Toolkit, XPixMap, and the Athena Widgets, while retaining the * mostly the same API. * - * GPLv2 or later, All Wrongs Reserved + * GPLv2 or later unless noted. + * Perl code dual-liscensed with the Artistic Liscense unless noted. */ /**standard libraries**/ @@ -186,7 +193,6 @@ //#include //#include //#include -#include /**compression libraries**/ #include @@ -198,9 +204,6 @@ #include #include -/**guile command executor**/ -#include - /**ncurses libraries**/ #include //#include @@ -209,6 +212,10 @@ // need to find a MIDI library. +/**local libraries**/ +#include "macro.h" +#include "constants.h" + mvaddch16(int x,int y,char16_t raw) { const wchar_t wch = raw; mvaddnwstr(13,16,&wch,1); @@ -240,21 +247,6 @@ char* TERM * if confusion arises from or, similar mesures will be implemented for it, too. */ -/*TYPES*/ -//ensure size names work on all systems -#define uint unsigned int -#define sint signed int -#define uchar uint8_t -#define schar int8_t -#define ushort uint16_t -#define sshort int16_t -#define umint uint32_t -#define smint int32_t -#define ulong unsigned long -#define slong signed long -#define ullong uint64_t -#define sllong int64_t - /* the 3D version of Iwannafly started off as a general RT-RPG library that * then became narrowed to a specific game. this version was originally * supposed to be the same game reworked for ncurses, @@ -558,17 +550,10 @@ move(10,0); printw(" [Z] %s?",opt3) } /*GLOBALS*/ -#define GRAV 3.2174 /*if you backtrack this to determine the size of a grid unit, you're trying to hard*/ playertyp PLAYER coord3 PLAYERSHD //position of player's shadow, for renderer latlontyp WORLD roomtyp* ROOM -#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 int(latlontyp)* ROOMGENCALL[ROOF + 1][EQUATOR/2 + 1][EQUATOR] shadowmask SHADOWKNOWS shadowmask SHINEALIGHT @@ -662,52 +647,6 @@ bitfield globools * #define ROOM_DOWN_NW_MASKBIT ((umint) 0x00000001) */ -#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 - /*end GLOBALS*/ getlinebuffer (y,x) @@ -1046,8 +985,8 @@ basearmortyp* armtable[256] baseshldtyp* shldtable[256] baubtyp* baubtable[256] -char* legendstabs[20] = {"truthseeker","sword of justice","excalibur","thunderbolt"/*torch of smiting*/,"sickle of chaos"/*+drain*/,"stormbringer"/*+drain*/,"devilfork"/*+fire*/,"partisen of tyrants","deathscyth"/*+drain*/,"sunray"/*spear + solar flare*/,"nightedge"/*sword + moonbeam*/,"staff of merlin"/*staff of magic missile*/,"firebrand"/*sword + fireball*/,"tesla's mace"/*+spark*/,"stormgale"/*bow*/,"frostpike"/*+frostbite*/,"trident of the seas"/*+tsunami*/,"staff of the forest"/*staff of animante kudzu*/,"groundshaker"/*+earthquake*/,"imperial baton"/*staff of antagonizing*/} -legendtyp legendtable[20] +char* legendstabs[20] = {"truthseeker","sword of justice","excalibur","thunderbolt"/*torch of smiting*/,"sickle of chaos"/*+drain*/,"stormbringer"/*+drain*/,"devilfork"/*+fire*/,"partisen of tyrants","deathscyth"/*+drain*/,"sunray"/*spear + solar flare*/,"nightedge"/*sword + moonbeam*/,"staff of merlin"/*staff of magic missile*/,"firebrand"/*sword + fireball*/,"tesla's mace"/*+spark*/,"stormgale"/*bow*/,"frostpike"/*+frostbite*/,"trident of the seas"/*+tsunami*/,"staff of the forest"/*staff of animante kudzu*/,"groundshaker"/*+earthquake*/,"imperial baton"/*staff of antagonizing*/}; +legendtyp legendtable[20]; char* psystabs[8] = {"detect alignment","charm","hold","sleep","mind blast","passify","unhinge","terrify"} @@ -1313,10 +1252,7 @@ uchar airmax //how long you can hold your breath symtabref lang0 : 6 symtabref lang1 : 6 uchar vocal[4] -symtabref spell0 -symtabref spell1 -symtabref spell2 -symtabref spell3 +symtabref spell[4] bitfield psyattack char16_t unichar bool unaligned : 1 @@ -1736,8 +1672,9 @@ uchar fly : 2 //0 = never had wings, 1 = slow falling, 2 = cannot gain altitude, * ⎩if n > 0 : success * * writing = - * succeed if 4D6 < dex if !talons, plus 1 in 20 odds of breaking pen on fail - * succeed if 6D6 < dex if talons, plus coinflip odds of breaking pen on fail + * succeed if 4D6 < dex if !talons, break pen on fail if 1D20 < stren + * succeed if 6D6 < dex if talons, break pen on fail if coinflip + * talons can engrave without tools */ readtyp: @@ -1802,12 +1739,14 @@ lightyp *lamp_ptr * *.bin# : signed binary data that is organized into n bit segments * *.hex : unsigned binary data that is organized into 8 bit segments * *.hex# : unsigned binary data that is organized into n bit segments + * *.r8 : the tilemap of a room * *.csv : UTF-8 text record deliminated with commas and line breaks * *.tsv : UTF-8 text record deliminated with tabs and line breaks * *.tab : same as tsv * *.so : a shared object. a game may use as many of these as it wants. Placing single-use functions in LD_LOAD_PATH is DISCOURAGED; they should be placed in the game's private files. * *.dat : internal data from inside a savefile * *.json : a less compact container format that does not allow linking + * *.pl.dump : a self-reassembling perl datastructure * *.asc : UTF-8 text record delimenated by newline. * *.txt : UTF-8 text document. usually stored in the program's static files, which is CAT-ed to provide dialouge; also used in dumps of primatives * *.ans : UTF-8 text record containing SGR sequences deleminated by newline. @@ -1820,6 +1759,9 @@ lightyp *lamp_ptr * * : documentation * *.html : documentation * *.texinfo : documentation + * *.pl : a perl script + * *.pm : a perl module + * *.PL : a build-related perl script * *.pod : perl documentation * *.d : everything relating to a struct is stored in the same directory, and pointers to structs are stored as subdirectories with the name of that field. the tail element in a linked list has no subdirectory named "next"; "prev" pointers are "../" implicitly. * *.conf : a configuration file, parsed with perl. @@ -1827,7 +1769,7 @@ lightyp *lamp_ptr * *.dump : a debugger data dump, with a format somwhere between JSON, INI, and C-like pseudocode. essentialy a dat file in readable (and non-raw) format. * * if the following new extensions collide with anything, I will change them. I specifically chose ones that were not a TLA or EFLA to try and avoid this, because there have been TDMTLA since before I came along. - * .midibas : midiBASIC, to be parsed by the midi generator into a .h file. Represents a different subset of general midi than regular midi files, but does so in a human readable format. + * *.midibas : midiBASIC, to be parsed by the midi generator into a .h file. Represents a different subset of general midi than regular midi files, but does so in a human readable format. */ /* dat file format: @@ -1836,13 +1778,14 @@ lightyp *lamp_ptr * DLE s8bit raw_data = a numeric field, abs(n) bits long. a negative number indicates the field is signed. * ACK = true * NAK = false + * SUB = -1 * NUL = empty string * XON path XOFF = a pointer to the data at path * * SYN = start an array or add a diminsion to the array * structs are terminated with ETB * arrays may have up to 4 dimensions seperated with FS GS RS and US. - * arrays are ended with EM + * arrays are ended with EM. */ struct mapgen_bordertyp { @@ -1897,7 +1840,7 @@ starfield_step(tube) starfield tube { xiter = MAX_X / 8 -for (uchar n = MAX_Y;n;n--) { +for (uchar n = MAX_X;n;n--) { for (uchar x = 0;x < xiter;x++) { tube[n][x] = tube[n-1][x] } @@ -2080,13 +2023,10 @@ struct eventtyp: (self) *next eventdata eventdatavals triggertyp whenthis -const char* ifthis -div_t ifargs -const char* dothis -div_t doargs -const char* name -bool language : 1 // 0 = guile, 1 = perl +const char* dothis //object to be loaded. must be a shared object with C linkage; but not necissarily one written in C. if NULL, is a built-in function. +int (*doit)(int,int,int,int) //if NULL, then the file at dothis is sent to perl instead of being loaded as an object uchar radius : 7 +bool show : 1 uchar up : 4 uchar down : 4 umint duration @@ -2155,7 +2095,6 @@ bool multiuse : 1 bool magic : 1 //whether the trap is a mechanism or a rune uchar color : 6 - struct subwarptyp { eventdata eventident bool perm : 1 @@ -2205,7 +2144,7 @@ uchar amount foodbasetyp: effectyp effect diceodds odds -uchar keepsfor +uchar keepsfor //0 means non-perishable uchar hp uchar nutri @@ -2213,6 +2152,7 @@ bool always(ushort,ushort,ushort,ushort){return true} enum objid: WEAPON_FLAG : contains subobjtyp calling baseweaptyp +LEGEND_FLAG : contains subobjtyp calling baseweaptyp POTION_FLAG : contains potiontyp READ_FLAG : contains readtyp FOOD_FLAG : contains subobjtyp containing foodtyp @@ -2256,19 +2196,19 @@ an UNDERLINE is a shadow note: unicode symbols are (mostly) used be their appearence, not by their meaning ) is a sword or dagger. ⍏ are polearms. \ is a staff. ¦ is a club. : is a mace. ℓ is a whip. ( is a bow. ⇤ is an arrow. ⍖ is a writing instrument. ⟦ is armor. [ is clothing. ] is a shield. ⟧ are cannons or greeves. % is meat. ⊞ is food (don't shoot it). $ is gold. ¢ is copper. -? is a misc item. ✥ is a shurkin. ↧ is a digging tool. ⌥ is a key or lockpick. ♫ is a lyre. ƒ is a violin. ♪ is a different music instrument. +? is a misc item. ↧ is a digging tool. ⌥ is a key or lockpick. ♫ is a lyre. ƒ is a violin. ♪ is a different music instrument. ¿ are potions (fragile). ∫ is a scroll. ⊒ is a book. ∩ is a tablet. ° is a ring. º is a bracelet. ª is an amulet. ^ is a crown. / is a wand. ♮ is a ladder. ⋎ is a fountain or gyser. ⍾ is a bell. ⎋ is a clockface. ♠ ♣ ‡ are trees. ⋏ is fire. ♜ is a pedestal. -∿ is shallow liquid. ≈ is deep liquid's surface. ∬ is a waterfall. ~ is a liquid (as seen while submerged). ≣ is a staircase. +≋ is deep liquid's surface. ∬ is a waterfall. ≈ is a shallow liquid's surface, or a deep liquid below surface. ~ (centered) is a puddle. ≣ is a staircase. ⌁ is electricity. * is ice. ⎈ spider web. ⌬ beehive. ↥ are spikes. ⎙ ⍝ ⎍ ∎ ⎅ are tombstones or signs. ␥ is glass. -! is trouble. ⌑ is a light source. ⌸ is a door. ⍯ is a locked door. ⎕ is an open door. = is a gate. ≠ is a locked gate. ∷ is an open gate. +! is trouble. ☀ is a light source. ⌸ is a door. ⍯ is a locked door. ⎕ is an open door. = is a gate. ≠ is a locked gate. ∷ is an open gate. • is a boulder. . is a rock. ⁂ is a rockslide. ◇ is a gemstone. ◊ is a giant magic crystal. ⑆ are footprints. -∪ is a sink. ⏍ is a chest. ↯ (cyan) is the thunderbolt. ∅ is a spacetime anomaly (do not touch). < > are level stairs. ⌘ is home. +∪ is a sink. ⏍ is a chest. ↯ is the thunderbolt. ∅ is a spacetime anomaly (do not touch). < > are level stairs. ⌘ is home. ← ↑ → ↓ ↖ ↗ ↘ ↙ are flying projectiles. ⇐ ⇑ ⇒ ⇓ ⇖ ⇗ ⇘ ⇙ are ballistae. ✪ is a rune. ː ⍽ are traps. -# █ ▓ ▒ ░ ▞ ▚ (etc) are thick walls or floor. ≋ is a cloud (do not walk on them; keep your head out of them). +# █ ▓ ▒ ░ ▞ ▚ (etc) are thick walls or floor. ≎ ☈ are clouds (do not walk on them; keep your head out of them). ˜ ␣ are holes. ' is a stalagtite or icicle. , is a plant. ; is a grain or sunflower (impassable). -box drawings are low walls or columns. ⑉ ⋮ are iron bars. · is an ember or star. ` ´ ˇ are flower petals. -¬ (blinking) is stale air (unbreathable). ≃ is stagnent water (unbreathable). ☣ ‽ is gas. +box drawings are low walls or columns. ⑉ ⋮ are iron bars. · is an ember or star. ` ´ are flower petals. +¬ is stale air (unbreathable). ∽ ⋍ is stagnent water (unbreathable). " deliminates text. ⍰ is a missingno. @@ -2279,6 +2219,8 @@ you'll have bigger issues of non-uniform characters warping and tearing the world's projection grid. it is for this reason that the recommended font is a raster one, as raster fonts tend to be more uniform. +a prompt at launch uses user responce to choose between using ~ or ∼ for centered tilde. + box drawings: ╒╤╕ ╔╦╗ ╞╪╡flat ╠╬╣upright @@ -2297,23 +2239,23 @@ and will use the full range of ANSI SGR escape codes rune symbols ◬ air, ⍫ earth, △ fire, ▽ water, ⍰ missingno -※ ice, ↯ (yellow) electricity, ♤ metal, ♻ nature -☣ status effect, ‽ stoning, ∅ entropy +※ ice, ☇ electricity, ♤ metal, ♻ nature +❖ status effect, ☣ poison, ¤ stoning, ∅ entropy ☼ light, ☽ dark, § polymorph, ↹ planer ♥ healing magic AOE symbols -≋ air, • earth, ⋏ fire, ≈ water +≋ air, • earth, ⋏ fire, ∿ water * ice, ⌁ electricity, ↥ metal, ♠ nature -☣ status effect, ‽ stoning, ∅ entropy -⌑ light, ⎈ dark, § polymorph +❖ status effect, ☣ poison, ¤ stoning, ‽ entropy +☀ light, ⎈ dark, § polymorph directional symbols: ←, ↑, →, ↓, ↖, ↗, ↘, ↙, direction in XY; ! far side; ↧, ↥, direction in Z; ↹ different plane; ◬, ⍫, △, ▽, ※, ↯, ♤, ♻, ☼, ☽, ∅, inner planes; -LG, NG, CG, LN, CN, LE, NE, CE, TN, ×, ☠, outer planes; +LG, NG, CG, LN, CN, LE, NE, CE, TN, UN, ☠, outer planes; STYLE GUIDE: the following nonstandard punctuation may be used in dialouge (list not exaustive) : ‽ explosive disbelief ⸮ rhetorical .ˢ sarcasm ♪ playful ♥ careing ♩♯ taunt ↯ explosive anger ☠ foul oath diff --git a/src/macro.h b/src/macro.h index 331a05c..729584d 100644 --- a/src/macro.h +++ b/src/macro.h @@ -1,16 +1,23 @@ +/*TYPES*/ +//ensure size names work on all systems +#define uint unsigned int +#define sint signed int +#define uchar uint8_t +#define schar int8_t +#define ushort uint16_t +#define sshort int16_t +#define umint uint32_t +#define smint int32_t +#define ulong unsigned long +#define slong signed long +#define ullong uint64_t +#define sllong int64_t + // prettify the tokens my eyes don't parse #define ≥ >= #define ≤ <= #define forever for (;;) -#ifndef OK -#define OK 0 -#endif - -#ifndef ERR -#define ERR -1 -#endif - #ifndef EOF #error now you're just TRYING to break stuff... #endif @@ -22,7 +29,6 @@ #define TRUE true #define FALSE false -#define NIL "" /*ENVIROMENTALS*/ #define BUFFER_MAX 512 @@ -53,10 +59,10 @@ /*FUNCTION MACROS*/ #define BACKGROUND 010 -#define MAX(A,B) (A > B ? A : B) -#define MIN(A,B) (A < B ? A : B) +#define MAX(A,B) (A ≥ B ? A : B) +#define MIN(A,B) (A ≤ B ? A : B) #define SGN(N) (N < 0 ? 1 : (N > 0 ? -1 : (N == 0 ? 0 : NAN))) -#define INTVL(A,N,B) MIN(MAX(A,N),B) +#define CLAMP(A,N,B) MIN(MAX(A,N),B) #define COORDSUB(Z,Y,X) ((MAX_Y * Z) + (MAX_X * Y) + X) // kludge so that stdio and ncurses play nice together diff --git a/src/modules/IWannaFly/CommandLine.pseudo b/src/modules/IWannaFly/CommandLine.pseudo new file mode 100644 index 0000000..fe5d5ea --- /dev/null +++ b/src/modules/IWannaFly/CommandLine.pseudo @@ -0,0 +1,9 @@ +permit_only(:base_core,rand); +share_from(IWannaFly'Macro,\@IWannaFly'Macro::EXPORT); +share_from(IWannaFly'Null,['NULL']); +share_from(IWannaFly,\@IWannaFly::EXPORT); +share_from(Math::RPN,'rpn'); +share_from(IWannaFly'Constants,\@IWannaFly'Constants::EXPORT); +share_from(IWannaFly'Paths,\@IWannaFly'Paths::EXPORT); +share_from(POSIX,[floor, ceil, strftime]); +share_from(Data::Dumper,[Dumper]); diff --git a/src/modules/IWannaFly/Constants.pm b/src/modules/IWannaFly/Constants.pm new file mode 100644 index 0000000..35b7de7 --- /dev/null +++ b/src/modules/IWannaFly/Constants.pm @@ -0,0 +1,101 @@ +package IWannaFly::Constants; +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT; +#AUTOGENERATED +use constant C__NIL => ""; +push(@EXPORT,C__NIL); +use constant C__OK => 0; +push(@EXPORT,C__OK); +use constant C__ERR => -1; +push(@EXPORT,C__ERR); +use constant C__GRAV => 3.2174; +push(@EXPORT,C__GRAV); +use constant C__MAX_X => 64; +push(@EXPORT,C__MAX_X); +use constant C__MAX_Y => 24; +push(@EXPORT,C__MAX_Y); +use constant C__MAX_Z => 16; +push(@EXPORT,C__MAX_Z); +use constant C__ROOF => 201; +push(@EXPORT,C__ROOF); +use constant C__EQUATOR => 360; +push(@EXPORT,C__EQUATOR); +use constant C__GOOD_MASK => 0700; +push(@EXPORT,C__GOOD_MASK); +use constant C__LAWFUL_MASK => 0444; +push(@EXPORT,C__LAWFUL_MASK); +use constant C__EVIL_MASK => 0007; +push(@EXPORT,C__EVIL_MASK); +use constant C__CHAOTIC_MASK => 0111; +push(@EXPORT,C__CHAOTIC_MASK); +use constant C__NEUT_HORIZ_MASK => 0070; +push(@EXPORT,C__NEUT_HORIZ_MASK); +use constant C__NEUT_VERT_MASK => 0222; +push(@EXPORT,C__NEUT_VERT_MASK); +use constant C__LAW_GOOD_BIT => 0400; +push(@EXPORT,C__LAW_GOOD_BIT); +use constant C__NEUT_GOOD_BIT => 0200; +push(@EXPORT,C__NEUT_GOOD_BIT); +use constant C__CHAOS_GOOD_BIT => 0100; +push(@EXPORT,C__CHAOS_GOOD_BIT); +use constant C__LAW_NEUT_BIT => 0040; +push(@EXPORT,C__LAW_NEUT_BIT); +use constant C__TRUE_NEUT_BIT => 0020; +push(@EXPORT,C__TRUE_NEUT_BIT); +use constant C__CHAOS_NEUT_BIT => 0010; +push(@EXPORT,C__CHAOS_NEUT_BIT); +use constant C__LAW_EVIL_BIT => 0004; +push(@EXPORT,C__LAW_EVIL_BIT); +use constant C__NEUT_EVIL_BIT => 0002; +push(@EXPORT,C__NEUT_EVIL_BIT); +use constant C__CHAOS_EVIL_BIT => 0001; +push(@EXPORT,C__CHAOS_EVIL_BIT); +use constant C__LAW_GOOD_WIDEMSK => 0764; +push(@EXPORT,C__LAW_GOOD_WIDEMSK); +use constant C__CHAOS_GOOD_WIDEMSK => 0731; +push(@EXPORT,C__CHAOS_GOOD_WIDEMSK); +use constant C__LAW_EVIL_WIDEMSK => 0467; +push(@EXPORT,C__LAW_EVIL_WIDEMSK); +use constant C__CHAOS_EVIL_WIDEMSK => 0137; +push(@EXPORT,C__CHAOS_EVIL_WIDEMSK); +use constant C__NEUTRAL_WIDEMSK => 0272; +push(@EXPORT,C__NEUTRAL_WIDEMSK); +use constant C__ELE_WATER_BIT => 0x80; +push(@EXPORT,C__ELE_WATER_BIT); +use constant C__ELE_ICE_BIT => 0x40; +push(@EXPORT,C__ELE_ICE_BIT); +use constant C__ELE_AIR_BIT => 0x20; +push(@EXPORT,C__ELE_AIR_BIT); +use constant C__ELE_ELEC_BIT => 0x10; +push(@EXPORT,C__ELE_ELEC_BIT); +use constant C__ELE_FIRE_BIT => 0x08; +push(@EXPORT,C__ELE_FIRE_BIT); +use constant C__ELE_METAL_BIT => 0x04; +push(@EXPORT,C__ELE_METAL_BIT); +use constant C__ELE_EARTH_BIT => 0x02; +push(@EXPORT,C__ELE_EARTH_BIT); +use constant C__ELE_TREE_BIT => 0x01; +push(@EXPORT,C__ELE_TREE_BIT); +use constant C__ELE_WATER_WIDEMSK => 0xC1; +push(@EXPORT,C__ELE_WATER_WIDEMSK); +use constant C__ELE_ICE_WIDEMSK => 0xE0; +push(@EXPORT,C__ELE_ICE_WIDEMSK); +use constant C__ELE_AIR_WIDEMSK => 0x70; +push(@EXPORT,C__ELE_AIR_WIDEMSK); +use constant C__ELE_ELEC_WIDEMSK => 0x38; +push(@EXPORT,C__ELE_ELEC_WIDEMSK); +use constant C__ELE_FIRE_WIDEMSK => 0x1C; +push(@EXPORT,C__ELE_FIRE_WIDEMSK); +use constant C__ELE_METAL_WIDEMSK => 0x0C; +push(@EXPORT,C__ELE_METAL_WIDEMSK); +use constant C__ELE_EARTH_WIDEMSK => 0x07; +push(@EXPORT,C__ELE_EARTH_WIDEMSK); +use constant C__ELE_TREE_WIDEMSK => 0x83; +push(@EXPORT,C__ELE_TREE_WIDEMSK); +use constant C__LIGHT_BIT => 04; +push(@EXPORT,C__LIGHT_BIT); +use constant C__DARK_BIT => 02; +push(@EXPORT,C__DARK_BIT); +use constant C__ENTROPY_BIT => 01; +push(@EXPORT,C__ENTROPY_BIT); diff --git a/src/modules/IWannaFly/LinkedList.pm b/src/modules/IWannaFly/LinkedList.pm new file mode 100644 index 0000000..53c7c6c --- /dev/null +++ b/src/modules/IWannaFly/LinkedList.pm @@ -0,0 +1,197 @@ +sub Head { + my $self = shift; + if (@_) { + $self->{Contents}[0]->%* = @_; + } + return $self->{Contents}[0]; + } + +sub Tail { + my $self = shift; + if (@_) { + $self->{Contents}[-1]->%* = @_; + } + return $self->{Contents}[-1]; + } + +sub Offset { + my $self = shift; + my $off = shift; + if ($off ≥ $self->{Contents}[#]) {return -1}; + if (@_) { + $self->{Contents}[$off]->%* = @_; + }; + return $self->{Contents}[$off]; + } + +sub Here { + my $self = shift; + if (@_) { + $self->{Current}->%* = @_; + } + return $self->{Current}; + } + +sub FromHere { + my $self = shift; + my $off = shift; + my $dest = $self->Here; + if ($off > 0) { + for (my $n = 0;$n < $off;$n++) { + if (defined($dest->{next})) { + $dest = $dest->{next}; + } + else {return -1} + } + } + elsif ($off < 0) { + for (my $n = 0;$n > $off;$n--) { + if (defined($dest->{prev})) { + $dest = $dest->{prev}; + } + else {return -1} + } + }; + if (@_) { + $dest->%* = @_; + }; + return $dest; + } + +sub Index { + my $self = shift; + for (my $n = 0;$n ≤ $self->{Contents}[#];n++) { + if (refaddr($self->Here) == refaddr($self->{Contents}[$n]) { + return $n; + }; + } + +sub Size { + my $self = shift; + return $self->{Contents}[#]; + } + +sub Adv { + my $self = shift; + if (defined($self->Here->{next}) { + $self->{Current} = $self->Here->{next}; + } + else {return -1}; + } + +sub Rew { + my $self = shift; + if (defined($self->Here->{Prev}) { + $self->{Current} = $self->Here->{Prev}; + } + else {return -1}; + } + +sub Seek { + my $self = shift; + my $off = shift; + if ($off > 0) { + for (my $n = 0;$n < $off;$n++) { + if (defined($self->Here->{next})) { + $self->{Current} = $self->Here->{next}; + } + else {return -1} + } + } + elsif ($off < 0) { + for (my $n = 0;$n > $off;$n--) { + if (defined($self->Here->{prev})) { + $self->{Current} = $self->Here->{prev}; + } + else {return -1} + } + }; + return $self->Here; + } + +sub Reset { + my $self = shift; + $self->{Current} = $self->Head; + return $self->Here; + } + +sub Set { + my $self = shift; + my $off = shift; + $self->{Current} = $self->Offset($off); + return $self->Here; + } + +# Linked lists are provided using objects with methods: +# ->Head is the first element; or an alias of ->Here for ¢ and § +# ->Tail is the last element, an alias of ->Here->{prev} for §, or a cached node whose ->{next} is equal to ->Here for ¢ +# ->Offset($) element $-offset from ->Head +# ->Here is the currently indexed element. +# ->FromHere($) element $-offset from ->Here +# ->Index the offset index from ->Head of ->Here. always 0 for § and ¢. +# ->Size the number of elements in the list. + +# ->Adv advances ->Here by 1 +# ->Rew rewinds ->Here by 1 +# ->Seek($) changes ->Here by $ +# ->Reset resets ->Here to ->Head. +# ->Set($) set ->Here to ->Head + $. + +# ->Push adds a new element after ->Tail with the same keys as ->Head. +# ->PushHere adds a new element after ->Here with the same keys as ->Head and moves to it. +# ->PushTo($) adds a new element at ->Offset($) with the same keys as ->Head. +# ->PushToHere($) adds a new element at ->FromHere($) with the same keys as ->Head. +# ->Shove adds a new element before ->Head with the same keys as ->Head. + +# ->Pop removes ->Tail, or the node immidiately before ->Here for § and ¢ +# ->PopHere removes ->Here +# ->PopAt($) removes ->Offset($) +# ->PopFrom($) removes ->FromHere($) +# ->Axe removes ->Head + +# ->Punt sends ->Here to ->Tail (Do not pass go do not collect 200 scalars.) Alias of ->Adv for § +# ->PuntAt($) sends ->Offset($) to ->Tail +# ->PuntFrom($) sends ->Fromhere($) to ->Tail, or to before ->Here for § and ¢ +# ->Put($) sends ->Here to ->Offset($) +# ->Throw($) sends ->Here to ->FromHere($) +# ->Move($) seeks by $ while still holding ->Here + +# ->Pull($) pull ->Offset($) to before ->Here +# ->PullFrom($) pull ->FromHere($) to before ->Here + +# ->Flip($) swaps ->FromHere($) and ->Here +# ->Flop($) swaps ->Offset($) and ->Here +# ->Swap swaps ->Tail and ->Here. +# ->Switch swaps ->Head and ->Here. +# any combination of (Flip|Flop|Swap|Switch)(Flip|Flop|Swap|Switch) except (Swap|Switch)(Swap|Switch) swap the non-here elements, with the args in that order. + +# ->FlushAll syncs all elements to their pointers + +# classes for linked list objects are: +# IWannaFly'LinkedList::Single +# IWannaFly'LinkedList::SingleCircle +# IWannaFly'LinkedList::Double +# IWannaFly'LinkedList::DoubleHalf +# IWannaFly'LinkedList::DoubleCircle + +# each linked list class supports: +# ::capture(%) makes a container around a recursive hash, with members +# named ->{next} containing the recursion, as are created by the +# data file parsers. ->{prev} members may be overwritten, and if +# the formatting does not match, this could cause a resource +# starvation loop, i.e., capturing a circularly linked list with +# the non-circular class. + +# the following are avalible for structs or linked list elements: +# ->{Ptr} is the C pointer to the struct. +# ->Flush syncs a struct object to its pointer. + +# each struct class supports: +# ::new makes an empty locked hash object with the fields of the struct, +# the additional field ->{Ptr}, and the method ->SYNC. +# ::fetch(°) creates a new container from the data at °. pointer fields +# are replaced with perl references to an object created in the same +# manner; null pointers are translated to undef, and undef is +# translated to null. +# ::malloc and ::calloc return a pointer address to a struct of that type +# ::capture(\%) makes a container around a hash diff --git a/src/modules/IWannaFly/Macro.pm b/src/modules/IWannaFly/Macro.pm deleted file mode 100644 index 627d4fe..0000000 --- a/src/modules/IWannaFly/Macro.pm +++ /dev/null @@ -1,62 +0,0 @@ -package IWannaFly'Macro; - -use warnings; -use strict; -use boolean; -use Scalar::Utils; -use Filter::Simple; - -FILTER_ONLY - code => sub { s/).*)-->//g }; -FILTER_ONLY - code => sub { s/≤/<=/g }; -FILTER_ONLY - code => sub { s/≥/>=/g }; -FILTER_ONLY - code => sub { s/NaN/"NaN"/ig }; -FILTER_ONLY - code => sub { s/(-?)INF(INITY)?/"$1Inf"/ig }; -FILTER_ONLY - code => sub { s/T(RUE|rue)/true/g }; -FILTER_ONLY - code => sub { s/F(ALSE|alse)/false/g }; -FILTER_ONLY - code => sub { s/NIL/''/g }; -FILTER_ONLY - code => sub { s/¤/\$/g }; -FILTER_ONLY - code => sub { s/£/\$/g }; -FILTER_ONLY - code => sub { s/€/\$/g }; -FILTER_ONLY - code => sub { s/§/\$/g }; -FILTER_ONLY - code => sub { s/¶/\$/g }; -FILTER_ONLY - code => sub { s/OK(AY)?/0/g }; -FILTER_ONLY - code => sub { s/OKAY/0/ig }; -FILTER_ONLY - code => sub { s/ERR/-1/ig }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:\(([\w]+)\)$/$1;\n\tgoto $2;\n/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:\{((?!\})\}$/$1;\n\t{$2};\n/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\{((?!\}).*)\}\n$/if ( $1 ) {\n\t$2;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\(([\w]+)\)\n$/if ( $1 ) {\n\tgoto $2;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\{((?!\}).*)\}\n$/unless ( $1 ) {\n\t$2;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:F\(([\w]+)\)\n$/unless ( $1 ) {\n\tgoto $2;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\{((?!\}).*)\}F\{((?!\}))\}\n$/if ( $1 ) {\n\t$2;\n\t}\nelse {\n\t$3;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\(((?!\)).*)\}F\{((?!\}))\}\n$/if ( $1 ) {\n\tgoto $2;\n\t}\nelse {\n\t$3;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\{((?!\}).*)\}F\(((?!\)))\}\n$/if ( $1 ) {\n\t$2;\n\t}\nelse {\n\tgoto $3;\n\t}/g }; -FILTER_ONLY - code => sub { s/«((?!»).*)»[\W]*:S\(([\w]+)\)F\(([\w]+)\)\n$/if ( $1 ) {\n\tgoto $2;\n\t}\nelse {\n\tgoto $3;\n\t}/g }; -FILTER_ONLY - code => sub { s/: int;/: optimize(int);/g }; diff --git a/src/modules/IWannaFly/Main.pm b/src/modules/IWannaFly/Main.pm index 0f3535d..c937d56 100644 --- a/src/modules/IWannaFly/Main.pm +++ b/src/modules/IWannaFly/Main.pm @@ -1,82 +1,31 @@ package IWannaFly::Main; -use lib '..'; + use strict; use warnings; +use Acme::Comment type=>'HTML'; + +use lib '..'; +use MyUtils::Null; +use MyUtils::Macro; +use MyUtils::Div; +use IWannaFly::Constants; +use IWannaFly::Paths; -use IWannaFly::Struct; -use IWannaFly'Macro; -use IWannaFly'Null; require Exporter; our @ISA = qw(Exporter); our @EXPORT; - +# this is a comment + +# ‰foo is a hash ref or struct # £foo is a singly linked list object # ¢fie is a singly, circularly linked list object # ♮bam is a doubly linked list # €baz is a doubly, half-circularly linked list # §qux is a doubly, circularly linked list # ¤zot is a reference -# ¶xyz is a regex - -# Linked lists are provided using objects: -# ->Head is the first element; or an alias of ->Here for ¢ and § -# ->Tail is the last element, or an alias of ->Here->{prev} for §, or the ref whose ->{next} is equal to ->here for ¢ -# ->Offset($) element $-offset from ->Head -# ->Here is the currently indexed element -# ->FromHere($) element $-offset from ->Here - -# ->Adv advances ->Here by 1 -# ->FFwd($) advances ->Here by $ -# ->Back rewinds ->Here by 1 -# ->Rew($) rewinds ->Here by $ -# ->Reset resets ->Here to ->Head. -# ->Set($) set ->Here to ->Head + $. - -# ->Push adds a new element after ->Tail -# ->PushHere adds a new element at ->Here -# ->PushAt($) adds a new element at ->Offset($) -# ->PushTo($) adds a new element at ->FromHere($) - -# ->Pop removes ->Tail, or the node immidiately before ->Here for § -# ->PopHere removes ->Here -# ->PopAt($) removes ->Offset($) -# ->PopFrom($) removes ->FromHere($) - -# ->Punt sends ->Here to ->Tail (Do not pass go do not collect 200 scalars.) Alias of ->Adv for § -# ->PuntAt($) sends ->Offset($) to ->Tail -# ->PuntFrom($) sends ->Fromhere($) to ->Tail, or to before ->Here for § - -# The hashes in the objects are maintained as references. - -# classes for the objects are: -# IWannaFly::LinkedList::Single -# IWannaFly::LinkedList::SingleCircle -# IWannaFly::LinkedList::Double -# IWannaFly::LinkedList::DoubleHalf -# IWannaFly::LinkedList::DoubleCircle - -# each class supports: -# ::new makes an empty container with the methods above -# ::capture(\%) makes a container around a recursive hash, with members named -# ->{next} containing the recursion, as are created by the data file parsers. -# ->{prev} members may be overwritten, and if the formatting does not match, -# this could invoke the halting problem, i.e., capturing a circularly linked -# list with the non-circular class - - - -sub MAX($$) {return ($_[0] ≥ $_[1] ? $_[0] : $_[1])} -push(@EXPORT,'MAX'); - -sub MIN($$) {return ($_[0] ≤ $_[1] ? $_[0] : $_[1])} -push(@EXPORT,'MIN'); - -sub SGN($) {$_ <=> 0} -push(@EXPORT,'SGN'); - -sub INTVL($$$) {return MIN( MAX( $_[0],$_[1] ) ,$_[2] )} -push(@EXPORT,'INTVL'); +# °abc is a C pointer +# ¶zyz is a regex diff --git a/src/modules/IWannaFly/Null.pm b/src/modules/IWannaFly/Null.pm deleted file mode 100644 index 6cf1bec..0000000 --- a/src/modules/IWannaFly/Null.pm +++ /dev/null @@ -1,13 +0,0 @@ -package IWannafly'Null; -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT = qw(NULL); -use Inline 'C'; -sub NULL { - iwfperl_inline_null; - } -__END__ -__C__ -void* iwfperl__inline__null() { - return NULL; - } diff --git a/src/modules/IWannaFly/Parse.pm b/src/modules/IWannaFly/Parse.pm deleted file mode 100644 index 3a983b3..0000000 --- a/src/modules/IWannaFly/Parse.pm +++ /dev/null @@ -1,260 +0,0 @@ -package IWannaFly::Parse; -use lib '..'; -use strict; -use warnings; -use feature "switch"; - -use IWannaFly::Struct; -use IWannaFly'Macro; -use IWannaFly'Null; -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT; - -sub PARSEDAT($) { - open(my $file, <, shift); - my $nextchar = getc($file); - my %output; - my @stack = (\%output); - my $isarray = 0; - my $counter = 0; - sub storedata($) { - my $tmp = shift; - if ($isarray) { - push(@{¤stack[-1]},$tmp); - } - else { - ¤stack[-1] = $tmp; - } - sub append($) { - my $tmp = shift; - push(@stack,¤stack[-1]->{$tmp}); - } - while ($nextchar != "\004") - for ($buffer) { - - when (/^\0/) { - storedata(NIL); - } - - when (/^\001/) { - my $string = do { - local $/ = "\a"; - <$file> - } - chomp $string; - append($string); - } - - when (/^\002/) { - my $string = do { - local $/ = "\003"; - <$file> - } - chomp $string; - storedata($string); - } - - when (/^\006) { - store(true); - } - - when (/^\020) { - my $length = unpack('c',getc($file)) : int; - read($file,my $buffer,abs($length)); - if (abs($length) ≤ 8) { - if ($length > 0) { - my $output = unpack('C',$buffer); - } - else { - my $output = unpack('c',$buffer); - } - } - elseif (abs($length) ≤ 16) { - if ($length > 0) { - my $output = unpack('S',$buffer); - } - else { - my $output = unpack('s',$buffer); - } - } - elseif (abs($length) ≤ 32) { - if ($length > 0) { - my $output = unpack('L',$buffer); - } - else { - my $output = unpack('l',$buffer); - } - } - else { - if ($length > 0) { - my $output = unpack('Q',$buffer); - } - else { - my $output = unpack('q',$buffer); - } - } - storedata($output); - } - - when (/^\021/) { - my $path = do { - local $/ = "\023"; - <$file> - } - chomp $path; - storedata(DOTYPE($path,$islinkedlist,\%output)); - } - - when (/^\025/) { - storedata(false); - } - - when (/^\026/) { - if ($isarray) { - push(@{¤stack[-1]},[]); - push(@stack,¤stack[-1]); - } - else { - ¤stack[-1] = []; - } - $isarray++; - }; - - when (/^\027/) { - pop(@stack); - $counter++; - } - - when (/^\034/) { - if ($isarray) { - for (my $n = 1;$n < $isarray;$n++) { - pop(@stack); - } - for (my $n = 0;$n < $isarray;$n++) { - push(@{¤stack[-1]},[]); - push(@stack,¤stack[-1]); - } - } - } - - when (/^\035/) { - if ($isarray) { - for (my $n = 1;$n < MAX($isarray - 1,1);$n++) { - pop(@stack); - } - for (my $n = 0;$n < MAX($isarray - 1,1;$n++) { - push(@{¤stack[-1]},[]); - push(@stack,¤stack[-1]); - } - } - } - - when (/^\036/) { - if ($isarray) { - for (my $n = 1;$n < MAX($isarray - 2,1);$n++) { - pop(@stack); - } - for (my $n = 0;$n < MAX($isarray - 2,1;$n++) { - push(@{¤stack[-1]},[]); - push(@stack,¤stack[-1]); - } - } - } - - when (/^\037/) { - if ($isarray) { - for (my $n = 1;$n < MAX($isarray - 3,1);$n++) { - pop(@stack); - } - for (my $n = 0;$n < MAX($isarray - 3,1;$n++) { - push(@{¤stack[-1]},[]); - push(@stack,¤stack[-1]); - } - } - } - $nextchar = getc($file); - } - (\%output,¤prev); - } - -sub EATTYPE($$¤) { - my $path = shift; - my $islinkedlist = shift; - my ¤prev = shift; - $path =~ m/\.([^.]+)$/; - my $type = $1; - $path =~ m/(\d)+$/; - my $width = $1 ? $1 : 8; - my $output; - my ¤next; - for ($filetype) { - when (/^dat$/) { - (¤output,¤next) = PARSEDAT($path,$islinkedlist,¤prev); - when (/^(tsv|tab)$/) { - ¤output = READTAB($path); - } - when (/^hex[\d]*$/) { - ¤output = READHEX($path,$width); - } - when (/^bin[\d]*$/) { - ¤output = READBIN($path,$width); - } - when (/^(asc|ans)$/) { - ¤output = READRECORD($path); - } - when (/^txt|nfo$/) { - $output = READTEXT($path); - when (/^json$/) { - open(my $file,'<',$path); - $output = do { - local $\ = undef; - from_json(<$file>); - } - - } - } - ($output,¤next); - } - -sub READTEXT($) { - open(my $file,'<',shift); - local $\ = undef; - my $output = <$file>; - } - -sub READRECORD($) { - open(my $file,'<',shift); - my @output; - for ($file;!eof<$file>;push(@output,<$file>)); - \@output; - } - -sub READTAB($) { - open(my $file,'<',shift); - chomp(my @rows = <$file>); - my @table; - foreach (@rows) { - my @columns = split("\t",$_); - push(@table,\@columns); - } - \@table; - } - -sub READBIN($$) { - open(my $file,'<',shift); - my $size = shift; - local $\ = undef; - my $type = $size == 8 ? 'c' : $size == 16 ? 's' : $size == 32 ? 'l' : $size == 64 ? 'q' : false; - «$type» :F{die invalid filename} - unpack($type,<$file>); - } - -sub READHEX($$) - open(my $file,'<',shift); - my $size = shift; - local $\ = undef; - my $type = $size == 8 ? 'C' : $size == 16 ? 'S' : $size == 32 ? 'L' : $size == 64 ? 'Q' : false; - «$type» :F{die invalid filename} - unpack($type,<$file>); - } diff --git a/src/modules/IWannaFly/Paths.pm b/src/modules/IWannaFly/Paths.pm new file mode 100644 index 0000000..4a7b0a7 --- /dev/null +++ b/src/modules/IWannaFly/Paths.pm @@ -0,0 +1,43 @@ +package IWannaFly::Paths; +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT; +#AUTOGENERATED +use constant ENV__LIB_PATH => '/usr/local/lib/iwannaflycurses/'; +push(@EXPORT,ENV__LIB_PATH); +use constant ENV__SHARE_LIB_PATH => '/usr/local/share/lib/iwannaflycurses'; +push(@EXPORT,ENV__SHARE_LIB_PATH); +use constant ENV__VAR_PATH => '/var/games/iwannaflycurses/'; +push(@EXPORT,ENV__VAR_PATH); +use constant ENV__GLOBAL_PATH => '/usr/local/share/etc/iwannaflycurses.d/'; +push(@EXPORT,ENV__GLOBAL_PATH); +use constant ENV__LIB_GAMES_PATH => '/usr/local/lib/games/iwannaflycurses/'; +push(@EXPORT,ENV__LIB_GAMES_PATH); +use constant ENV__SHARE_LIB_GAMES_PATH => '/usr/local/share/lib/games/iwannaflycurses/'; +push(@EXPORT,ENV__SHARE_LIB_GAMES_PATH); +use constant ENV__INSTALL_MAN => 1; +push(@EXPORT,ENV__INSTALL_MAN); +use constant ENV__MAN_PATH => '/usr/local/share/man/'; +push(@EXPORT,ENV__MAN_PATH); +use constant ENV__INSTALL_INFO => 1; +push(@EXPORT,ENV__INSTALL_INFO); +use constant ENV__INSTALL_DOC => 1; +push(@EXPORT,ENV__INSTALL_DOC); +use constant ENV__DOC_PATH => '/usr/local/share/doc/iwannaflycurses/'; +push(@EXPORT,ENV__DOC_PATH); +use constant ENV__INSTALL_HTML => 1; +push(@EXPORT,ENV__INSTALL_HTML); +use constant ENV__HTML_PATH => '/usr/local/share/doc/iwannaflycurses/'; +push(@EXPORT,ENV__HTML_PATH); +use constant ENV__INSTALL_SRC => 1; +push(@EXPORT,ENV__INSTALL_SRC); +use constant ENV__SRC_PATH => '/usr/local/share/src/iwannaflycurses/'; +push(@EXPORT,ENV__SRC_PATH); +use constant ENV__GAMES_PATH => '/usr/local/games/'; +push(@EXPORT,ENV__GAMES_PATH); +use constant ENV__BIN_PATH => '/usr/local/bin/'; +push(@EXPORT,ENV__BIN_PATH); +use constant ENV__DOT_PATH => '~/.iwannaflycurses/'; +push(@EXPORT,ENV__DOT_PATH); +use constant ENV__PERL_PATH => '/usr/lib/i386-linux-gnu/perl/5.24.1/CORE/'; +push(@EXPORT,ENV__PERL_PATH); diff --git a/src/modules/IWannaFly/Types/free.pm b/src/modules/IWannaFly/Types/free.pm deleted file mode 100644 index c00a8e6..0000000 --- a/src/modules/IWannaFly/Types/free.pm +++ /dev/null @@ -1,20 +0,0 @@ -package IWannaFly::Types::free -use warnings; -use strict; -use IWannaFly'Macro; -use IWannaFly::Types::free'xs; -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT = qw(free destructor); - -sub free(°) { - my °Ptr = shift; - IWannaFly::Types::free'xs::iwfperl_free(°Ptr); - TRUE; - } - -sub destructor(£) { - my £struct = shift; - free(£struct->{Ptr}); - undef £struct; - } diff --git a/src/modules/MyUtils/Div.pm b/src/modules/MyUtils/Div.pm new file mode 100644 index 0000000..9107f81 --- /dev/null +++ b/src/modules/MyUtils/Div.pm @@ -0,0 +1,19 @@ +package MyUtils::Div; + +use strict; +use warnings; +use hash::util; + +use lib '..'; +use IWannaFly::DivXS; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(div); + +sub div($$) { + my $foo = shift; + my $bar = shift; + my \%div_t = IWannaFly'xsub::iwf_perlxs_div($foo,$bar); + return lock_keys(%$div_t); + } diff --git a/src/modules/MyUtils/DivXS.xs b/src/modules/MyUtils/DivXS.xs new file mode 100644 index 0000000..5b8afee --- /dev/null +++ b/src/modules/MyUtils/DivXS.xs @@ -0,0 +1,16 @@ + #define PERL_NO_GET_CONTEXT + #include + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + MODULE="IWannaFly::DivXS" PACKAGE="IWannaFly::DivXS" + + HV* + iwf_perlxs_div(numer,denom) + int numer + int denom + CODE: + div_t tmp = div(numer,denom); + RETVAL = newHV(); + hv_store(RETVAL,"quot",4,newSViv(tmp.quot),0); + hv_store(RETVAL,"rem",4,newSViv(tmp.rem),0); diff --git a/src/modules/MyUtils/Macro.pm b/src/modules/MyUtils/Macro.pm new file mode 100644 index 0000000..7f4cfc2 --- /dev/null +++ b/src/modules/MyUtils/Macro.pm @@ -0,0 +1,36 @@ +package MyUtils::Macro; + +use warnings; +use strict; +use Filter::Simple; +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(NAN INFINITY OK ERR π noop MAX MIN SGN CLAMP); + +use constant INFINITY => 'Inf'; +use constant NAN => 'NaN'; +use constant OK => 0; +use constant ERR => -1; +use constant π = 4 * atan2(1,1); + +sub noop {} +sub MAX($$) {return (( $_[0] ≥ $_[1] ) ? $_[0] : $_[1])} +sub MIN($$) {return (( $_[0] ≤ $_[1] ) ? $_[0] : $_[1])} +sub SGN($) {return ($_ <=> 0)} +sub CLAMP($$$) {return MIN( MAX( $_[0],$_[1] ),$_[2] )} + +FILTER_ONLY + code_no_comments => sub { s/≤/<=/g }, + code_no_comments => sub { s/≥/>=/g }, + code_no_comments => sub { s/‰/\$/g }, + code_no_comments => sub { s/°/\$/g }, + code_no_comments => sub { s/¤/\$/g }, + code_no_comments => sub { s/¢/\$/g }, + code_no_comments => sub { s/♮/\$/g }, + code_no_comments => sub { s/£/\$/g }, + code_no_comments => sub { s/€/\$/g }, + code_no_comments => sub { s/§/\$/g }, + code_no_comments => sub { s/¶/\$/g }, + code_no_comments => sub { s/T(?:rue|RUE)/true/g }, + code_no_comments => sub { s/F(?:alse|ALSE)/false/g }, + code_no_comments => sub { s/(?:^|(?<=[\{]))((?:[\w]+[:])?[\s]*)forever/$1for (;;)/gm }; diff --git a/src/modules/MyUtils/Main.pm b/src/modules/MyUtils/Main.pm new file mode 100644 index 0000000..eb4d7bf --- /dev/null +++ b/src/modules/MyUtils/Main.pm @@ -0,0 +1,67 @@ +package MyUtils::Main; + +use strict +use warnings; +require Math::BigInt; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT; + +sub factorial($) { + my $n = shift; + use Math::BigInt; + my $x = 1; + do {$x *= $n--} while $n; + return $x; + } +push(@EXPORT,'factorial'); + +sub nPr($$) { + my $n = shift; + my $k = shift; + if ($k > $n) {return 0}; + return (factorial($n) / factorial($n - $k)); + } +push(@EXPORT,'nPr'); + +sub nCr($$) { + my $n = shift; + my $k = shift; + if ($k > $n) {return 0}; + return (factorial($n) / (factorial($k) * factorial($n - $k))); + } +push(@EXPORT,'nCr'); + + +sub Perl__roll($$$) { + my $num = shift; + my $side = shift; + my $low = shift; + my $accum; + for (my $n, $n < $num, $n++) { + $accum += int(rand($side)) + $low; + } + $accum; + } +push(@EXPORT,'Perl__roll'); + +sub Perl__bonus($) { + my $num = shift; + my $accum; + for (my $n, $n < $num, $n++) { + $accum += int(rand(3)) - 1; + } + $accum; + } +push(@EXPORT,'Perl__bonus'); + +sub Perl__flipcoin { + int(rand(2)); + } +push(@EXPORT,'Perl__flipcoin'); + +sub Perl__choose { + return $_[int(rand(@_))]; + } +push(@EXPORT,'Perl__choose'); diff --git a/src/modules/MyUtils/Null.pm b/src/modules/MyUtils/Null.pm new file mode 100644 index 0000000..5996df6 --- /dev/null +++ b/src/modules/MyUtils/Null.pm @@ -0,0 +1,18 @@ +Package MyUtils::Null; + +use strict; +use warning; +use lib '..'; +use MyUtils::NullXS; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(NULL free); + +sub NULL { + return MyUtils::NullXS::myperlxs__null(); + } + +sub free($) { + MyUtils::NullXS::myperlxs__free($_); + } diff --git a/src/modules/IWannaFly/Types/XSLIB/free.xs b/src/modules/MyUtils/NullXS.xs similarity index 54% rename from src/modules/IWannaFly/Types/XSLIB/free.xs rename to src/modules/MyUtils/NullXS.xs index 8326fec..67d1c1f 100644 --- a/src/modules/IWannaFly/Types/XSLIB/free.xs +++ b/src/modules/MyUtils/NullXS.xs @@ -3,10 +3,15 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" - MODULE="IWannaFly::Types::free'xs" PACKAGE="IWannaFly::Types::free'xs" + MODULE="MyUtils::NullXS" PACKAGE="MyUtils::NullXS" + + void* + myperlxs__null() + CODE: + RETVAL = NULL; void - iwfperl_free(input) + myperlxs__free(input) void* input CODE: free(input); diff --git a/src/modules/MyUtils/SnoTo.pm b/src/modules/MyUtils/SnoTo.pm new file mode 100644 index 0000000..fcfc07e --- /dev/null +++ b/src/modules/MyUtils/SnoTo.pm @@ -0,0 +1,18 @@ +package MyUtils::SnoTo; + +use warnings; +use strict; +use Filter::Simple; + +FILTER_ONLY + code_no_comments => sub { s/^(?:[\w]:)?[\s]*([\S]+(?:[\s]+[\S]+)*)[\s]+:\(([\w]+)\)$/$1; goto $2;/gm }, + code_no_comments => sub { s/^(?:[\w]:)?[\s]*([\S]+(?:[\s]+[\S]+)*)[\s]+:S\(([\w]+)\)$/if ($1) {goto $2};/gm }, + code_no_comments => sub { s/^(?:[\w]:)?[\s]*([\S]+(?:[\s]+[\S]+)*)[\s]+:F\(([\w]+)\)$/unless ($1) {goto $2};/gm }, + code_no_comments => sub { s/^(?:[\w]:)?[\s]*([\S]+(?:[\s]+[\S]+)*)[\s]+:S\(([\w]+)\)F\(([\w]+)\)$/if ($1) {goto $2} else {goto $3};/gm }, + code_no_comments => sub { s/^(?:[\w]:)?[\s]*([\S]+(?:[\s]+[\S]+)*)[\s]+:F\(([\w]+)\)S\(([\w]+)\)$/unless ($1) {goto $2} else {goto $3};/gm }, + code_no_comments => sub { s/«(.*?)»[\s]*:\(([\w]+)\)$/$1; goto $2;/gms }, + code_no_comments => sub { s/«(.*?)»[\s]*:S\(([\w]+)\)$/if ($1) {goto $2};/gms }, + code_no_comments => sub { s/«(.*?)»[\s]*:F\(([\w]+)\)$/unless ($1) {goto $2};/gms }, + code_no_comments => sub { s/«(.*?)»[\s]*:S\(([\w]+)\)F\(([\w]+)\)$/if ($1) {goto $2} else {goto $3};/gms }, + code_no_comments => sub { s/«(.*?)»[\s]*:F\(([\w]+)\)S\(([\w]+)\)$/unless ($1) {goto $2} else {goto $3};/gms }, + code_no_comments => sub { s/→([\w]+)/goto($1)/g };