diff options
| author | Karl Berry <karl@freefriends.org> | 2017-03-06 21:58:50 +0000 |
|---|---|---|
| committer | Karl Berry <karl@freefriends.org> | 2017-03-06 21:58:50 +0000 |
| commit | aba00871ee9f5f5ac8d46fe9d0b8e29cd8ce1e8b (patch) | |
| tree | 98276bb92499bc5ceb7c72cda4393f028520fc4a /Build/source | |
| parent | 346afec669dbe142884f0794af09981c591e6afd (diff) | |
rubik (6mar17)
git-svn-id: svn://tug.org/texlive/trunk@43415 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source')
| -rwxr-xr-x | Build/source/texk/texlive/linked_scripts/rubik/rubikrotation.pl | 2504 |
1 files changed, 1974 insertions, 530 deletions
diff --git a/Build/source/texk/texlive/linked_scripts/rubik/rubikrotation.pl b/Build/source/texk/texlive/linked_scripts/rubik/rubikrotation.pl index 77c3dadbab3..05e69ef0049 100755 --- a/Build/source/texk/texlive/linked_scripts/rubik/rubikrotation.pl +++ b/Build/source/texk/texlive/linked_scripts/rubik/rubikrotation.pl @@ -1,84 +1,128 @@ #!/usr/bin/env perl ## -use Carp; -use Fatal; -use warnings; -## -our $version = "3.0 (25 Sept 2015)"; -##--------------------------- -## -## rubikrotation.pl -## VERSION 3.0 -## Copyright 25 September, 2015, -## RWD Nickalls (dick@nickalls.org) -## A Syropoulos (asyropoulos@yahoo.com) -## -##-------------------------------- -## changes in v3.0: -## 1) accepts command-line arguments for input (mandatory) and output (optional) filenames -## default output filename is: rubikOUT.txt -## 2) included the symbols [ and ] to denote a rotation-name label (ie as well as *) -## 3) fixed some of the variable definitions (as highlighted by <use strict> pragma) -##-------------------------------- -## changes in v2.3: -## 1) accepts a single commandline argument (datafilename) -## 2) uses the standard modules Carp and Fatal (give extra line info on error) -##-------------------------------- -## changes in v2.2: -## 1) changed licence --> LatexPP -## 2) included random n errors in ERROR messages (lines 492--495) -## 3) included version number in error message -##------------------------------ -# -# This file is part of the LaTeX rubikrotation package, and -# requires rubikcube.sty and rubikrotation.sty -# -# rubikrotation.pl is a Perl-5 program and free software: -# This program can be redistributed and/or modified under the terms -# of the LaTeX Project Public License Distributed from CTAN -# archives in directory macros/latex/base/lppl.txt; either -# version 1 of the License, or any later version. -# -# rubikrotation.pl is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -##--------------------------------------------------------------------- -## OVERVIEW -## This program is part of the rubikrotation package, and is complementary to -## the LaTeX rubikcube package. It processes Rubik rotation sequences on-the-fly. -## The program reads a datafile (rubikstate.dat) output by the rubikcube package -## and writes the new state to the file rubikstateNEW.dat, which is then input -## by the TeX file. Further documentation accompanies the rubikrotation package. - -## Note that all possible state changing rotations of a 3x3x3 cube are -## either combinations of, or the inverse of, just 9 different rotations, -## three associated with each XYZ axis. -##-------------------------------------------------- - -##=============main=================================================== - -## This main module opens three files, and -## sets up an array for collecting all errors (%error), and sets an error flag to "", -## reads in the rubik state data file =rubikstate.dat (output by TeXfile), -## and calls subs to write the TeX_OUT_FILE, -## and finally closes all files. -## Each line of the input file consists of a comma separated list of arguments. -## The first argument in each line of the file rubikstate.dat is the rubikkeyword. -## Program is documented in the rubikrotation.pdf (see section ``Overview'') - -our $source_file=""; -our $out_file="rubikOUT.txt"; #default -our $argc=@ARGV; -our $commandLineArgs = join(" ", @ARGV); -our $showargs="\tcommandline args = $commandLineArgs\n"; -our $usage="\tUsage: rubikrotation [-h|--help|-v|--version] -i <input file> [-o <out file>]\n"; -our $rubikversion="\tVersion: this is rubikrotation version $version\n"; -# -## check for correct number of commandline arguments and allocate filenames -# -if ($argc == 0||$argc > 4 ){ # croak if 0 or more than 4 arguments + use Carp; + use Fatal; + use warnings; + ## + our $version = "v4.0 (03 March 2017)"; + ## + ## rubikrotation.pl + ## VERSION 4.0 + ## + ## Copyright 03 March 2017, + ## RWD Nickalls (dick@nickalls.org) + ## A Syropoulos (asyropoulos@yahoo.com) + ## + ##------------------------------- + ## changes in v3.6 (January 2017) + ## (1) included Jaap Rm and Rc notation + ## (2) new sub for improved expansion of mod-4 multiples of rotations (Oct 2016) + ## (3) restructured to facilitate processing arrays through the rotation sub + ## (4) included option for an <info> block + ## (5) included Randelshofer superset ENG 3x3 notation + ## (6) implemented an `inverse' mode + ## (7) improved syntax checking + ## (8) used perltidy to polish the program layout + ## (but only when making the pdf documentation-- see file rubikrotationPL.pdf) + ## (9) included a lot of new subroutines + ##-------------------------------- + ## changes in v3.2: + ## 1) changed program, prog --> script + ## 2) added leading ... to the comments written by the <writestate> sub + ## (the ... code indicates that comments are written by the Perl script) + ## + ## 3) v3.2a added a \RubikSeqNEW{...} output line in the output file + ## to facilitate typesetting the rotation sequence (works OK just now) + ## + ## 4) v3.2c: added new commands: + ## \RotationSequenceName{} + ## \RotationSequenceClean{} + ## + ## 5) v3.2d: changed the returned command names (removed the Rotation part to keep it simple) + ## \Sequence{} = orig seq + NO NAME + ## \SequenceName{} = NAME only + ## \SequenceClean{} = clean seq + NO NAME + ## + ## 6) v3.2e:(25 Sept 2016) + ## changed some command names: use short & long for the Rubik R2 --> R,R code + ## (more intuitive than Clean) + ## \Sequence{} --> SecquenceShort{} + ## \SequenceClean{} --> SecquenceLong{} + ## removed the [ and ] around [name] variable + ## + ## 7) v3.2h: (2 Oct 2016) + ## improved the mod 4 routine using SUB rubikmod() + ## improved comments to log file re: rotation processing + ## + ##-------------------------------- + ## changes in v3.0: + ## 1) accepts command-line arguments for input (mandatory) and output (optional) filenames + ## default output filename is: rubikOUT.txt + ## 2) included the symbols [ and ] to denote a rotation-name label (ie as well as *) + ## 3) fixed some of the variable definitions (as highlighted by <use strict> pragma) + ##-------------------------------- + ## changes in v2.3: + ## 1) accepts a single commandline argument (datafilename) + ## 2) uses the standard modules Carp and Fatal (give extra line info on error) + ##-------------------------------- + ## changes in v2.2: + ## 1) changed licence --> LatexPP + ## 2) included random n errors in ERROR messages (lines 492--495) + ## 3) included version number in error message + ##------------------------------ + # + # This file is part of the LaTeX rubikrotation package, and + # requires rubikcube.sty and rubikrotation.sty + # + # rubikrotation.pl is a Perl-5 program and free software: + # This program can be redistributed and/or modified under the terms + # of the LaTeX Project Public License Distributed from CTAN + # archives in directory macros/latex/base/lppl.txt; either + # version 1 of the License, or any later version. + # + # rubikrotation.pl is distributed in the hope that it will be useful, + # but WITHOUT ANY WARRANTY; without even the implied warranty of + # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + # GNU General Public License for more details. + + ##--------------------------------------------------------------------- + ## OVERVIEW + ## This program is part of the rubikrotation package, and is complementary to + ## the LaTeX rubikcube package. It processes Rubik rotation sequences on-the-fly. + ## The program reads a datafile (rubikstate.dat) output by the rubikcube package + ## and writes the new state to the file rubikstateNEW.dat, which is then input + ## by the TeX file. Further documentation accompanies the rubikrotation package. + + ## Note that all possible state changing rotations of a 3x3x3 cube are + ## either combinations of, or the inverse of, just 9 different rotations, + ## three associated with each XYZ axis. + ##---------------------------------------------------------------------- + + ##------------------ MAIN -------------------------- + + ## This main module opens three files, and + ## sets up an array for collecting all errors (%error), and sets an error flag to "", + ## reads in the rubik state data file =rubikstate.dat (output by TeXfile), + ## and calls subs to write the TeX_OUT_FILE, + ## and finally closes all files. + ## Each line of the input file consists of a comma separated list of arguments. + ## The first argument in each line of the file rubikstate.dat is the rubikkeyword. + ## Program is documented in the rubikrotation.pdf (see section ``Overview'') + ##--------------- + ## set autoflush for outputs + ## $|=1; + ##-------------- + our $source_file=""; + our $out_file="rubikOUT.txt"; #default + our $argc=@ARGV; + our $commandLineArgs = join(" ", @ARGV); + our $showargs="\tcommandline args = $commandLineArgs\n"; + our $usage="\tUsage: rubikrotation [-h|--help|-v|--version] -i <input file> [-o <out file>]\n"; + our $rubikversion="\tVersion: this is rubikrotation version $version\n"; + # + ## check for correct number of commandline arguments and allocate filenames + # + if ($argc == 0||$argc > 4 ){ # croak if 0 or more than 4 arguments croak $rubikversion,$showargs, "\tWrong no of arguments\n", $usage; @@ -86,8 +130,8 @@ if ($argc == 0||$argc > 4 ){ # croak if 0 or more than 4 arguments else { SWITCHES: while($_ = $ARGV[0]) { - shift; - if (/^-h$/ || /^--help$/ ) { + shift; + if (/^-h$/ || /^--help$/ ) { die $rubikversion,$usage, "\twhere,\n" . "\t[-h|--help]\tgives this help listing\n" . @@ -96,10 +140,10 @@ if ($argc == 0||$argc > 4 ){ # croak if 0 or more than 4 arguments "\t[-o] \tcreates specified output file\n", "\tFor documentation see: rubikrotation.pdf,\n", "\trubikrotationPL.pdf and rubikcube.pdf.\n\n"; - } - elsif (/^-v$/ || /^--version$/ ) {die $rubikversion;} - elsif (/^-i$/) { - if (!@ARGV){ + } + elsif (/^-v$/ || /^--version$/ ) {die $rubikversion;} + elsif (/^-i$/) { + if (!@ARGV){ croak $showargs, "\tNo input file specified!\n", $usage; @@ -108,8 +152,8 @@ if ($argc == 0||$argc > 4 ){ # croak if 0 or more than 4 arguments $source_file = $ARGV[0], shift; } - } - elsif (/^-o$/) { + } + elsif (/^-o$/) { if (!@ARGV) { croak $showargs, "\tNo output file specified!\n", @@ -119,114 +163,184 @@ if ($argc == 0||$argc > 4 ){ # croak if 0 or more than 4 arguments $out_file = $ARGV[0], shift; } - } - elsif (/^-\w+/) { + } + elsif (/^-\w+/) { croak $showargs, "\t$_: Illegal command line switch!\n", $usage; - } - else { + } + else { croak $showargs, "\tmissing filenames or ? missing -i or -o switch!\n", $usage; - } - } # end of while -}; # end of else + } + } # end of while + }; # end of else -print "This is rubikrotation version $version\n"; -#================================ - open(IN_FILE, "<$source_file") ||croak "\tCan't open source file: $source_file\n"; - open(TeX_OUT_FILE, ">$out_file")||croak "\tCan't open output file: $out_file\n"; + #================================ - ## create error file (for append) - open (ERROR_OUT_FILE, ">>rubikstateERRORS.dat")||croak "ERROR: can't open file rubikstateERRORS.dat\n"; + open(IN_FILE, "<$source_file") ||croak "\tCan't open source file: $source_file\n"; + open(TeX_OUT_FILE, ">$out_file")||croak "\tCan't open output file: $out_file\n"; + + ## create error file (for append) + open (ERROR_OUT_FILE, ">>rubikstateERRORS.dat")||croak "ERROR: can't open file rubikstateERRORS.dat\n"; ## use dots for Perl messages (I have used dashes for LaTeX messages in the .sty) ## gprint sub prints its argument (message) to both the screen and to the TeX_OUT_FILE + gprint (""); # newline gprint ("...PERL process.................................."); - gprint ("...program = rubikrotation.pl v$version"); + gprint ("...script = rubikrotation.pl $version"); -## setup global error parameters, so we can write all the errors to a file as an array -my %error = (); # setup an array for error messages (was %) -my $erroralert = ""; # error flag -my $errornumber = 0; #set number of errors to zero + ## setup global error parameters, so we can write all the errors to a file as an array + our %error = (); # setup an array for error messages (was %) + our $erroralert = ""; # error flag + our $errornumber = 0; #set number of errors to zero gprint ("...reading the current rubik state (from File: $source_file)"); -my $dataline = ""; -my $rubikkeyword = ""; -my $rotationcommand = ""; -my @data; + our $dataline = ""; + our $newdataline =""; + our $rubikkeyword = ""; + our $rotationcommand = ""; + our @data=(); + + our $Sequence=""; ## will hold the original (SHORT) sequence + our $rotationseqNEW = ""; ## will hold the LONG sequence + our $RotationSequenceName=""; + + our $SequenceName=""; + our $SequenceShort=""; + our $SequenceLong=""; + our $SequenceInfo=""; + + #---------inverse mode------------ + # a keyword INVERSE or inverse in an infoblock <..> + # FLAG is set (line 400) in response to detecting an infloblock. + # A set FLAG triggers (a) reversing rotation sequence (line 484), + # and (b) inverting each rotation (to generate the inverse sequence). + # Here we define direction FLAG for the INVERSE sequence of rotations. + # The conditional test is in the SUB rotation + our $inverse="INV"; + our $directionflag=""; + #------------------------- + LINE: while (<IN_FILE>){ next LINE if /^#/; #skip comments next LINE if /^%/; #skip comments - next LINE if /^$/; #skip blank lines + next LINE if /^$/; #skip blank lines + + + print " \n TOP --------- (new line)\n\n"; + $dataline = $_; # grab the whole line as a string - chomp $dataline; # remove the line-ending characters - #$n++; # count the number of lines - @data=split (/,/, $dataline); # create an array called data - ## we have 10 fields (0--9) - ## check for rubikkeyword= up,down,left,right,front,back,checkstate,rotation: - gprint ("...$dataline"); - $rubikkeyword=$data[0]; - - if ($rubikkeyword eq 'up') { + chomp $dataline; # remove the line-ending character + + ## now we can clean whitespace + $dataline = cleanstring($dataline); + + #check syntax of the string + $rotationcommand=$dataline; ## needed for error messages + CheckSyntax($dataline); + + ## form an array so we can process the (rubik)keywords. + @data=split (/,/, $dataline); # create an array called data + + print " dataline array = @data\n"; + #------------------------- + + ## we have 10 fields (0--9) + ## check for rubikkeyword= up,down,left,right,front,back,checkstate,rotation: + $rubikkeyword=$data[0]; + + if ($rubikkeyword eq 'up') { gprint ("...$dataline"); $Ult[0]=$data[1], $Umt[0]=$data[2],$Urt[0]=$data[3], $Ulm[0]=$data[4], $Umm[0]=$data[5],$Urm[0]=$data[6], - $Ulb[0]=$data[7], $Umb[0]=$data[8],$Urb[0]=$data[9] - } + $Ulb[0]=$data[7], $Umb[0]=$data[8],$Urb[0]=$data[9]; + next LINE; + }; - if ($rubikkeyword eq 'down') { + if ($rubikkeyword eq 'down') { gprint ("...$dataline"); $Dlt[0]=$data[1], $Dmt[0]=$data[2],$Drt[0]=$data[3], $Dlm[0]=$data[4], $Dmm[0]=$data[5],$Drm[0]=$data[6], - $Dlb[0]=$data[7], $Dmb[0]=$data[8],$Drb[0]=$data[9] - } - if ($rubikkeyword eq 'left') { + $Dlb[0]=$data[7], $Dmb[0]=$data[8],$Drb[0]=$data[9]; + next LINE; + }; + + if ($rubikkeyword eq 'left') { gprint ("...$dataline"); $Llt[0]=$data[1], $Lmt[0]=$data[2],$Lrt[0]=$data[3], $Llm[0]=$data[4], $Lmm[0]=$data[5],$Lrm[0]=$data[6], - $Llb[0]=$data[7], $Lmb[0]=$data[8],$Lrb[0]=$data[9] - } - if ($rubikkeyword eq 'right') { + $Llb[0]=$data[7], $Lmb[0]=$data[8],$Lrb[0]=$data[9]; + next LINE; + }; + + if ($rubikkeyword eq 'right') { gprint ("...$dataline"); $Rlt[0]=$data[1], $Rmt[0]=$data[2],$Rrt[0]=$data[3], $Rlm[0]=$data[4], $Rmm[0]=$data[5],$Rrm[0]=$data[6], - $Rlb[0]=$data[7], $Rmb[0]=$data[8],$Rrb[0]=$data[9] - } - - if ($rubikkeyword eq 'front') { + $Rlb[0]=$data[7], $Rmb[0]=$data[8],$Rrb[0]=$data[9]; + next LINE; + }; + + if ($rubikkeyword eq 'front') { gprint ("...$dataline"); $Flt[0]=$data[1], $Fmt[0]=$data[2],$Frt[0]=$data[3], $Flm[0]=$data[4], $Fmm[0]=$data[5],$Frm[0]=$data[6], - $Flb[0]=$data[7], $Fmb[0]=$data[8],$Frb[0]=$data[9] - } - if ($rubikkeyword eq 'back') { + $Flb[0]=$data[7], $Fmb[0]=$data[8],$Frb[0]=$data[9]; + next LINE; + }; + + if ($rubikkeyword eq 'back') { gprint ("...$dataline"); $Blt[0]=$data[1], $Bmt[0]=$data[2],$Brt[0]=$data[3], $Blm[0]=$data[4], $Bmm[0]=$data[5],$Brm[0]=$data[6], - $Blb[0]=$data[7], $Bmb[0]=$data[8],$Brb[0]=$data[9] - } - -## if the rubikkeyword is `checkstate' we just check the -## state and write the output data to a file. + $Blb[0]=$data[7], $Bmb[0]=$data[8],$Brb[0]=$data[9]; + next LINE; + }; + + ## if the rubikkeyword is `checkstate' + ## we just check the state and write the output data to a file. if ($rubikkeyword eq 'checkstate') { gprint ("..."); $rotationcommand=$dataline; ## used in output message gprint ("...command=$rotationcommand"); checkstate(); - }; - -## if the rubikkeyword is `rotation' we first check to see if the second argument=random. -## if so, then we check that the third argument is an integer, if so --> random sub -## else --> exit line and get next line. -## finally we write the output data to a file. - - if ($rubikkeyword eq 'rotation') - { - gprint ("..."); + next LINE ; + }; + + ## IF the rubikkeyword is `rotation' + ## we first check to see if the second argument=random. + ## ---if so, then we check that the third argument is an integer, + ## ---if it is an integer n --> random => random(n) + ## ELSE it must be a rotation sequence --> send elements to rotation sub. + + + #------------------------ + if ($rubikkeyword eq 'rotation') + { + gprint ("..."); + + # we now grab a copy of the dataline, and we shall use this + # in the ErrorMessage SUB to indicate which command + # an error is in. $rotationcommand=$dataline; ## used in output message gprint ("...command=$rotationcommand"); + # need to check that a second argument exists (else --> ErrorMessage). + # ---should be either `random', + # ---or a macroname for a rotation sequence, + # ---or the first element of a rotation sequence. + + if ($data[1] eq "") + { # no second argument + gprint ("..*missing second argument"); + ErrorMessage ("QUITTING PERL PROGRAM --- missing second argument:"); + ErrorMessage ("--- ? bad rotation macro-name"); + quitprogram(); + }; + + + ##-----random----------------- ## if second argument = random, ## THEN we also need to check if third argument is an integer; @@ -235,363 +349,654 @@ my @data; if ($data[1] eq 'random') { if ($data[2] =~/\D/) { - errormessage("[$data[2]] not an integer"); - ## we reject the whole line and look at next line in the file - next + ## if true then cannot be a number (D matches for word elements) + ErrorMessage("[$data[2]] is not an integer"); + ## we reject the command (as bad syntax) and get next line + next LINE; } else{ - ## data[2] must be an integer (n), so we just do n random rotations - random($data[2]) + ## the next argument is an integer (n), so we do n random rotations + random($data[2]); + next LINE; }; - } + } ## end of IF + #--------------- + else { - # the line must be an ordinary rotation sequence line, so send the sequence - # to the rotation sub, BUT, need to first remove the - # rubikkeyword `rotation' from the begining of line (array) - # as we need to send ONLY the sequence string to the rotation sub. - - ## remove keyword rotation - shift (@data); - - ## process @data string by the rotation sub - rotation(@data); - } - } -##------------------------------- -## place additional keywords here -##------------------------------- - }; ## end of while + # -----rotation sequence--------- + # the line must be a rotation sequence line, so send the sequence + # to the rotation sub; + + # Note that a copy of the rotation command is already held in the + # variable rotationcommand (see above). It is used in the + # ErrorMessage SUB. + + + #------------------------------- + + # Process and remove any infoblocks if they exist + # infoblocks are text delimited by <...> + # The SUB cutinfoblock returns the name of the new revised string = newdataline, + # and also the contents of the infoblock = $SequenceInfo + # RubikRotation command uses infoblocks to cary keywords, eg INVERSE or inverse + # If several infoblocks exist, then we collect the contents into + # variable SequenceInfo, and separate them with a colon; + + infoblockcolon($dataline); + $dataline=$newdataline; + $newdataline=""; ## reset the variable + + + gprint ("...dataline = $dataline"); + + + ## now pass the string to cutinfoblock + local @seq=(); + + while ( (index $dataline, '<') !=-1 ){ + + cutinfoblock($dataline); + # best to use the whole word <inverse> to avoid errors + if ($SequenceInfo =~ m/(inverse|INVERSE)/) {$directionflag=$inverse; + print " FLAG set to = $inverse\n"; + }; + # append each infoblock to an array + push @seq, $SequenceInfo; + $dataline = $newdataline; + }; + + # finally, we join the seqInfo array into a string so we can print it + $SequenceInfo = join ("; ", @seq); + + + #---------------------------------- + ## there are now no more infoblocks, so we now look for repeat-blocks. + + ## reformulate any repeat blocks (,) --> {;} if they exist + ## this is to allow us to process any repeat blocks as separate elements + # this sub returns the name of the new revised string. + while ( (index $dataline, '(') !=-1 ){ + fixrepeatelement ($dataline); + $dataline=$newdataline; + $newdataline=""; ## reset the variable + }; + + ## rename remaining dataline string as SequenceShortBrace + ## since if there are any repeat blocks, they are now reformulated with braces + $SequenceShortBrace=$dataline; - ## we have finished reading in all the lines from the source file, - ## and doing all the rotations etc, so we now just write the new cube state + + ## clean leading and trailing whitespace + $SequenceShortBrace = cleanstring($SequenceShortBrace); + + ##---------------- + ## form a new array from $SequenceShortBrace (since we have changed the format + ## slightly; ie some commands may have been reformulated as semicolons). + @data=split (/,/, $SequenceShortBrace); + + + ## need to remove keyword <rotation> (= first element in the array) + ## removing it late like this is convenient for error checking purposes, + ## as then the keyword `rotation' is on the string + shift (@data); + + + + ## now need to recreate the string from the array @data for use later + ## (as rotation keyword has been removed) + + $SequenceShortBrace = join (",", @data); + + + #-----create SequenceShort, so we can output it later---- + + # since the `rotating' keyword has been removed, we can + # replace any braces around repeat strings (if exist) and + # rename it as SequenceShort which we will output at the end. + if ( (index $SequenceShortBrace, '{') !=-1 ) + { + print " repairing braces--> ()\n"; + ## swap: BBook p 138--139 + $SequenceShortBrace =~ tr/\{/(/; # swap , --> ; + $SequenceShortBrace =~ tr/\}/)/; # swap ( --> { + $SequenceShortBrace =~ tr/;/,/; # swap ) --> } + }; + + #rename to SequenceShort + $SequenceShort = $SequenceShortBrace; + + print " SequenceShort = $SequenceShort\n"; + ##---------------------------- + + + ## now we continue processing the array "data" + + my $n = 0; ##total no of array elements in "data" + $n = ($#data +1); + print " processing rotation arguments: = @data (n= $n)\n"; + + + # setup a loop counter (for use in the rotation sub) + # this is used to identify the first element (rcode) + # and used to grab [name] --> SequenceName. + our $jrcode=0; + + ## --------check for state of direction flag---------------------- + ## FLAG defined in line 224. + ## FLAG is set in line 400 on detecting <..> delimeters = infoblock + ## if flag set (by inverse keyword) then reverse the sequence array + if ( $directionflag eq $inverse){ + # FLAG is set, so we need to inverse the array + gprint ("...directionFLAG set; reversing array..."); + # but before reversing, look at the first array element + # to see if it is a square bracket element = NAME element + # so check the first char to see if it is [ + if (substr ($data[0], 0,1) eq '[') { + $SequenceName=$data[0]; + print " SequenceName (inv) = $SequenceName \n"; + }; + + @data = reverse @data; + print " processing rotation arguments: = @data (n= $n)\n"; + }; + + # send each rotation element to the sub rotation() + print " CALLing SUB rotation\n"; + + foreach $element (@data) { + ## clean leading and trailing white space + $element = cleanstring($element); + ## send element to rotation SUB + rotation($element); + }; + + } # end of else + }; # end of IF (rotation keyword) + + #---------------------------------------------- + ## place any new keywords for processing here + ##--------------------------------------------- + + }; ## end of while + + ## we have now finished reading in all the lines from the source file, + ## and processing all the rotations etc, + ## so we now just write the new cube state ## to the output file = TeX_OUT_FILE (so LaTeX can read it) - writestate(); - close; ##close all files - exit; + ## plus any ErrorMessages + ## -- all these are handled by the quitprogram sub + + quitprogram(); + ##==============end of main========================== -##=============================subs==================== - -sub errormessage{ -## writes the argument as a standard error message to out file - my $errormess = $_[0]; - $erroralert = "YES"; ## set error alert flag (for use in out message) - $error[$errornumber] = "** ERROR: $errormess"; - $errornumber++; ## increment number -}; - -##====================================== -## prints argument (comments) to screen and also to TeX_OUT_FILE. -## The typeout commands will find its way into the log file when read by latex -## Important to include trailing % for messages written to the TeX_OUT_FILE -## to stop extra <spaces> being seen by TeX. -sub gprint{ - my $gmess=$_[0]; - print "$gmess\n"; - print (TeX_OUT_FILE "\\typeout{$gmess}\%\n"); - }; -##======================================== + sub rotation { -sub checkstate{ -### simple check to see if wrong no of colours being used etc -### uses the cubie colours as used by rubikcube package= ROYGBWX +print " SUB rotation\n"; - gprint ("...checking state of cube"); + ## here we process the array @data (from main) consisting of all + ## the rotation commands associated with + ## a single RubikRotation command -- the `rotation' key word has already been removed + ## so we start here with [name] if it exists. - my @cubies=($Ult[0],$Umt[0],$Urt[0], $Ulm[0],$Umm[0],$Urm[0], $Ulb[0],$Umb[0],$Urb[0], - $Dlt[0],$Dmt[0],$Drt[0], $Dlm[0],$Dmm[0],$Drm[0], $Dlb[0],$Dmb[0],$Drb[0], - $Llt[0],$Lmt[0],$Lrt[0], $Llm[0],$Lmm[0],$Lrm[0], $Llb[0],$Lmb[0],$Lrb[0], - $Rlt[0],$Rmt[0],$Rrt[0], $Rlm[0],$Rmm[0],$Rrm[0], $Rlb[0],$Rmb[0],$Rrb[0], - $Flt[0],$Fmt[0],$Frt[0], $Flm[0],$Fmm[0],$Frm[0], $Flb[0],$Fmb[0],$Frb[0], - $Blt[0],$Bmt[0],$Brt[0], $Blm[0],$Bmm[0],$Brm[0], $Blb[0],$Bmb[0],$Brb[0]); + ##--------------------------- + ## variables used in SUBs rotation() and rubikmod() + ## need to be defined outside the SUBs -my $R=0,my $O=0,my $Y=0,my $G=0,my $B=0,my $W=0,my $X=0; + $modnumber=-1; #multiple associated with the char, eg D2 etc + $rotcode=""; + $rotnumber=0; + #------------------ + my @repeatcode = (); -my $cubiecolour = ""; + my $m=-1; + my $originalrcode=""; + my $j; ## used with m below + my $numberofchars; ## length of a string + my $nfrontchars; -foreach $cubiecolour (@cubies) - { - if ($cubiecolour eq R) {$R = $R+1} - elsif ($cubiecolour eq O) {$O = $O+1} - elsif ($cubiecolour eq Y) {$Y = $Y+1} - elsif ($cubiecolour eq G) {$G = $G+1} - elsif ($cubiecolour eq B) {$B = $B+1} - elsif ($cubiecolour eq W) {$W = $W+1} - elsif ($cubiecolour eq X) {$X = $X+1} - else {print " cubiecolour counting ERROR \n";} - }; -my $cubiesum=0; -$cubiesum = $R+$O+$Y+$G+$B+$W+$X; -gprint ("...cubiesum = $cubiesum (Red=$R, Or=$O, Ye=$Y, Gr=$G, Bl=$B, Wh=$W, X=$X)"); + ##----------------- -if ($cubiesum != 54) { errormessage("cubiesum not = 54")}; -if ($R >9){ errormessage("No of Red cubies > 9 (=$R)")}; -if ($O >9){ errormessage("No of Orange cubies > 9 (=$O)")}; -if ($Y >9){ errormessage("No of Yellow cubies > 9 (=$Y)")}; -if ($G >9){ errormessage("No of Green cubies > 9 (=$G)")}; -if ($B >9){ errormessage("No of Blue cubies > 9 (=$B)")}; -if ($W >9){ errormessage("No of White cubies > 9 (=$W)")}; -}; + ## grab the rotation code passed to this sub from MAIN + my $rcode = $_[0]; -##==================================================== -# no of arguments passed to the sub = $#_ (black book p 156) + ## now we start a big loop processing each cs-element (= rcode), + ## and collecting these elements into two cs-strings + ## ($Sequence --> original string output as SHORT string (has codes like R2,L3 etc), + ## and $rotationseqNEW --> output as LONG string -- all short codes expanded) - sub rotation { -## here we process the array @data (from main) consisting of all -## the rotation commands associated with -## a single RubikRotation command. - - my $m; #multiple associated with the char, eg D2 etc - my $n = ($#_ +1); ##total no of arguments passed - my $originalchar=""; - my $j; - my $numberofchars; ## length of a string - my $nfrontchars; - my $char = ""; - - gprint ("...arguments passed to `rotation' sub = @_ (n= $n)"); - foreach $char (@_) { - $char =~s/^\s+//, $char=~s/\s+$//; ## clean leading and trailing white space - ## grab a copy of the original char for use if m Mod4=0 - $originalchar=$char; - - ## if argument has a leading * or [ or ] then it is a label (not a rotation) - ## so jump to next one - if (substr ($char,0,1) =~ /[ * \[ \] ]/ ){ - gprint ("...$char is a label OK"); - next; - }; - - ## Need to detect any trailing integer associated with a command (eg rotation multiple, eg:U3, L2 etc) - ## NOTES: since we are using mod4, we are only interested in trailing digit - ## if trailing character is a digit, then - ## split char string into front chars (= $char) + trailing digit (= $m) - $m = 1; # initialise m - - ## if terminal char is a digit (d) then let d --> m and let frontstring --> char - ## (Black book p 130 & 136) - ## if the frontstring contains any digits then it will be rejected in the filter below anyway. - - if ( substr ($char,-1) =~ /(\d)/) - { - $m = $1; ## grab the trailing digit (only traps a single digit) - $numberofchars = 0; #initialise it - $numberofchars = length $originalchar; - $nfrontchars = $numberofchars-1; - ## reassign the string except the terminal digit - $char = substr($char,0,$nfrontchars); - ## use MOD 4 since we are dealing with Rubik rotations - $m = $m % 4; - ## (if MOD 4 = 0 then nothing will happen as j starts at 1) - ## but should generate an errormessage - if ( $m == 0 ){ - gprint ("...rotation $originalchar equiv 0;(MOD 4) (NOT IMPLEMENTED)"); - errormessage ("[$originalchar] in RubikRotation (4 MOD 4 = 0)"); - next; - }; + + ## first, clean leading and trailing white space (eg between, R ,) + $rcode = cleanstring($rcode); + + + ## grab a copy of the element (char) for use if m Mod4=0 + $originalrcode=$rcode; + + ## increment the loop counter (initialised in MAIN) + $jrcode=$jrcode+1; ## increment rotation element (char) counter + + + ## ---------------------------------- + ## We look at the first character of each element in the sequence + ## if an element has a leading [ then it is a label (not a rotation) + ## should really be matched, but this is not checked for at present. + ## If this is the case, then jump to next element in the array + + ## BUT if trailing comma is missing, then next rotation is included as part of the label + ## so need to trap this and test: is first AND last char a sq bracket? + + if ( (substr ($rcode,0,1) =~ /\[/) and (substr ($rcode,-1) ) =~ /\]/) { + + gprint ("...$rcode is a label OK"); + + if ($directionflag eq $inverse) { + # do nothing + } + + else{ + ## if this `label' is also the FIRST element, then label = name + if ($jrcode ==1) {$SequenceName=$rcode}; + }; # end of IF + + ## now get next rotation element + next; + }; ## end of if + + ##-------------- + + ## the rcode must therefore be either a rotation code or a repeat-block. + + ##---------------------------------------- + ## we have already replaced any repeat (,) with {;} + ## so we now check for elements with leading { and then expand them. + + ## Note that if there is NO comma before the {} of a {repeat block}, then + ## the true repeat block will not be recognised by the + ## usual test -- since the test is looking for a leading { etc. + ## However, in this event, the string being handled (not a true element) + ## will be processed as if it were a rotation, and an + ## error will be thrown, so it will get picked up OK. + + if (substr ($rcode,0,1) =~ /\{/ ) + { + print " repeat block found = $rcode \n"; + + ## since we now want to send each rotation element in the repeat block to + ## the rotation sub, we need to replace any ; with commas + ## therefore translate ; --> , but retain the {} + $rcode =~ tr/;/,/; + + print " repeat block reformulated = $rcode \n"; + + + #-------log file message-------- + ## log file: we want to show the repeat string in the users original form + ## so we translate it back to the user's orig form {,} --> (,) + $origrcode=$rcode; + $origrcode =~ tr/\{/(/; + $origrcode =~ tr/\}/)/; + gprint ("...Expanding: $origrcode ..."); + #------------- + + + #----------- + ## expand the code in the repeat block + print " CALLing SUB: repeat($rcode)\n"; + + repeat($rcode); # this expands the repeated elements in the block + + ## this sub returns the expanded form as $insert + $expanded_repeatcode=$insert; + + print " expanded_repeatcode = $expanded_repeatcode\n\n"; + #------------ + + #---------------- + # process each new element in the expanded_repeatcode --> rotation + # make expanded_repeatcode into an array, and send each element on + + @repeatcode = split (/,/, $expanded_repeatcode) ; + + + ## -----------check for direction flag----------------- + ## if flag set then reverse the array + if ( $directionflag eq $inverse){@repeatcode = reverse @repeatcode}; + + + # send each element to rotation SUB for processing + print " CALLing SUB rotation\n"; + foreach $E (@repeatcode) { + print " sending repeat element $E to rotation SUB\n"; + rotation($E) + }; + + # when this foreach is finished, then get next rotation element from + # the original @data array (see foreach.. near end of MAIN) + next; + + }; ## end of if + + ##================================ + + ## if an element has got this far, it must be a single rotation code + ## (maybe with a trailing digit), so it needs processing as a rotation + ## and appending the code to what will become the SequenceLONG string. + + ##------------------------ + + ## CALL the sub rubikmod to process the rotation element, + ## and to return the front code (= $rotcode), orig no = $rotnumber, + ## and mod4 value (= $modnumber). + + rubikmod($rcode); + + ## update rcode <--- rotcode (returned by the SUB rubikmod() ) + ## collect $m <--- modnumber (returned by the SUB rubikmod() ) + $rcode = $rotcode; + $m = $modnumber; + + ## we collect all the new versions of rcode into a cs-string = $SequenceLong + ## which will finally be output as the LONG string + +#----------------------- +# check with directionflag + if ($directionflag eq $inverse) {$rcode = inverse ($rcode)}; +#------------------------- + + ##-------------------- + if ( $m == 0 ) + { + ## do NOT implement the rotation code, and do NOT append to SequenceLong + ## print the /original/ rcode (eg R4, or D0 etc) + gprint ("..*rotation ,$originalrcode, ERROR ($rotnumber = 0 mod 4) not implemented"); + ErrorMessage(",$originalrcode, -- ($rotnumber = 0 mod 4) not implemented"); + next; }; - ## if single trailing digit present, then we implement the rotation command m times. + + if ( $m == 1 ) + { + if($rotnumber >=5) + {gprint ("...Expanding $originalrcode ($rotnumber = $m mod 4) ...")}; + $SequenceLong=$SequenceLong.$rcode.","; + } + else { + # m = 2 or 3 + if($rotnumber >=5) + {gprint ("...Expanding $originalrcode ($rotnumber = $m mod 4) ...")} + else {gprint ("...Expanding $originalrcode ...")}; + + for($j=1; $j<=$m; $j++) + {## append rcode m times to sequenceLONG + $SequenceLong=$SequenceLong.$rcode."," + }; + }; ## end of else + + ##------------------- + + ## if single trailing digit present, + ## then we implement the rotation command m times. ## if more than one trailing digit ## then the error is trapped at the end (as frontstring will not be recognised ## ie will not be in the following list, and hence will be trapped as an error, eg R3) - ## - if ($char eq "R") {for($j=1;$j<=$m;$j++) { gprint ("...rotation R OK"); &rrR}} - elsif ($char eq "Rp") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Rp OK (= rrR3)"); &rrRp}} - elsif ($char eq "Rw") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Rw OK (= rrR + rrSr)"); &rrRw}} - elsif ($char eq "Rwp") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Rwp OK (= rrRp + rrSrp)"); &rrRwp}} - elsif ($char eq "Rs") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Rs OK (= rrR + rrLp)"); &rrRs}} - elsif ($char eq "Rsp") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Rsp OK (= rrRp + rrL)"); &rrRsp}} - elsif ($char eq "Ra") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Ra OK (= rrR + rrL)"); &rrRa}} - elsif ($char eq "Rap") {for($j=1;$j<=$m;$j++) { gprint ("...rotation Rap OK (= rrRp + rrLp)"); &rrRap}} - #### - elsif ($char eq "L") {for($j=1;$j<=$m;$j++) {gprint ("...rotation L OK (= rrLp3)"); &rrL}} - elsif ($char eq "Lp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lp OK"); &rrLp}} - elsif ($char eq "Lw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lw OK (= rrLp3 + rrSrp)"); &rrLw}} - elsif ($char eq "Lwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lwp OK (= rrLp + rrSr)"); &rrLwp}} - elsif ($char eq "Ls") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ls OK (= rrL + rrRp)"); &rrLs}} - elsif ($char eq "Lsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lsp OK (= rrLp + rrR)"); &rrLsp}} - elsif ($char eq "La") {for($j=1;$j<=$m;$j++) {gprint ("...rotation La OK (= rrL + rrR)"); &rrLa}} - elsif ($char eq "Lap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lap OK (= rrLp + rrRp)"); &rrLap}} - #### - elsif ($char eq "U") {for($j=1;$j<=$m;$j++) {gprint ("...rotation U OK"); &rrU}} - elsif ($char eq "Up") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Up OK (= rrU3)"); &rrUp}} - elsif ($char eq "Uw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Uw OK (= rrU + rrSu)"); &rrUw}} - elsif ($char eq "Uwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Uwp OK (= rrUp + rrSup)"); &rrUwp}} - elsif ($char eq "Us") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Us OK (= rrU + rrDp)"); &rrUs}} - elsif ($char eq "Usp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Usp OK (= rrUp + rrD)"); &rrUsp}} - elsif ($char eq "Ua") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ua OK (= rrU + rrD)"); &rrUa}} - elsif ($char eq "Uap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Uap OK (= rrUp + rrDp)"); &rrUap}} - #### - elsif ($char eq "D") {for($j=1;$j<=$m;$j++) {gprint ("...rotation D OK (= rrDp3)"); &rrD}} - elsif ($char eq "Dp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dp OK "); &rrDp}} - elsif ($char eq "Dw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dw OK (= rrDp3 + rrSup)"); &rrDw}} - elsif ($char eq "Dwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dwp OK (= rrDp + rrSu)"); &rrDwp}} - elsif ($char eq "Ds") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ds OK (= rrD + rrUp)"); &rrDs}} - elsif ($char eq "Dsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dsp OK (= rrDp + rrU)"); &rrDsp}} - elsif ($char eq "Da") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Da OK (= rrD + rrU)"); &rrDa}} - elsif ($char eq "Dap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dap OK (= rrDp + rrUp)"); &rrDap}} - #### - elsif ($char eq "F") {for($j=1;$j<=$m;$j++) {gprint ("...rotation F OK"); &rrF}} - elsif ($char eq "Fp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fp OK (= rrF3)"); &rrFp}} - elsif ($char eq "Fw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fw OK (= rrF + rrSf)"); &rrFw}} - elsif ($char eq "Fwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fwp OK (= rrFp + rrSfp)"); &rrFwp}} - elsif ($char eq "Fs") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fs OK (= rrF + rrBp)"); &rrFs}} - elsif ($char eq "Fsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fsp OK (= rrFp + rrB)"); &rrFsp}} - elsif ($char eq "Fa") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fa OK (= rrF + rrB)"); &rrFa}} - elsif ($char eq "Fap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fap OK (= rrFp + rrBp)"); &rrFap}} + + + if ($rcode eq "L") {for($j=1;$j<=$m;$j++) {gprint ("...rotation L, OK (= Lp3)"); &rrL}} + elsif ($rcode eq "Lp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lp, OK"); &rrLp}} + elsif ($rcode eq "Lw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lw, OK (= Lp3 + Srp)"); &rrLw}} + elsif ($rcode eq "Lwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lwp, OK (= Lp + Sr)"); &rrLwp}} + elsif ($rcode eq "Ls") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ls, OK (= L + Rp)"); &rrLs}} + elsif ($rcode eq "Lsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lsp, OK (= Lp + R)"); &rrLsp}} + elsif ($rcode eq "La") {for($j=1;$j<=$m;$j++) {gprint ("...rotation La, OK (= L + R)"); &rrLa}} + elsif ($rcode eq "Lap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Lap, OK (= Lp + Rp)"); &rrLap}} + #### + elsif ($rcode eq "R") {for($j=1;$j<=$m;$j++) {gprint ("...rotation R, OK"); &rrR}} + elsif ($rcode eq "Rp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Rp, OK (= R3)"); &rrRp}} + elsif ($rcode eq "Rw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Rw, OK (= R + Sr)"); &rrRw}} + elsif ($rcode eq "Rwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Rwp, OK (= Rp + Srp)"); &rrRwp}} + elsif ($rcode eq "Rs") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Rs, OK (= R + Lp)"); &rrRs}} + elsif ($rcode eq "Rsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Rsp, OK (= Rp + L)"); &rrRsp}} + elsif ($rcode eq "Ra") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ra, OK (= R + L)"); &rrRa}} + elsif ($rcode eq "Rap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Rap, OK (= Rp + Lp)"); &rrRap}} #### - elsif ($char eq "B") {for($j=1;$j<=$m;$j++) {gprint ("...rotation B OK (= rrFp3)"); &rrB}} - elsif ($char eq "Bp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bp OK"); &rrBp}} - elsif ($char eq "Bw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bw OK (= rrFp3 + rrSfp)"); &rrBw}} - elsif ($char eq "Bwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bwp OK (= rrFp + rrSf)"); &rrBwp}} - elsif ($char eq "Bs") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bs OK (= rrB + rrFp)"); &rrBs}} - elsif ($char eq "Bsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bsp OK (= rrBp + rrF)"); &rrBsp}} - elsif ($char eq "Ba") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ba OK (= rrB + rrF)"); &rrBa}} - elsif ($char eq "Bap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bap OK (= rrBp + rrFp)"); &rrBap}} + elsif ($rcode eq "U") {for($j=1;$j<=$m;$j++) {gprint ("...rotation U, OK"); &rrU}} + elsif ($rcode eq "Up") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Up, OK (= U3)"); &rrUp}} + elsif ($rcode eq "Uw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Uw, OK (= U + Su)"); &rrUw}} + elsif ($rcode eq "Uwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Uwp, OK (= Up + Sup)"); &rrUwp}} + elsif ($rcode eq "Us") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Us, OK (= U + Dp)"); &rrUs}} + elsif ($rcode eq "Usp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Usp, OK (= Up + D)"); &rrUsp}} + elsif ($rcode eq "Ua") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ua, OK (= U + D)"); &rrUa}} + elsif ($rcode eq "Uap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Uap, OK (= Up + Dp)"); &rrUap}} #### - elsif ($char eq "Su") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Su OK "); &rrSu}} - elsif ($char eq "Sup") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sup OK (= rrSu3)"); &rrSup}} - elsif ($char eq "Sd") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sd OK (= rrSup)"); &rrSd}} - elsif ($char eq "Sdp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sdp OK (= rrSu)"); &rrSdp}} - elsif ($char eq "Sl") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sl OK (= rrSrp)"); &rrSl}} - elsif ($char eq "Slp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Slp OK (= rrSr)"); &rrSlp}} - elsif ($char eq "Sr") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sr OK"); &rrSr}} - elsif ($char eq "Srp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Srp OK (= rrSr3)"); &rrSrp}} - elsif ($char eq "Sf") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sf OK"); &rrSf}} - elsif ($char eq "Sfp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sfp OK (= rrSf3)"); &rrSfp}} - elsif ($char eq "Sb") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sb OK (= rrSfp)"); &rrSb}} - elsif ($char eq "Sbp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sbp OK (= rrSf)"); &rrSbp}} - ## XYZ stuff - ## need to include lowercase x,y,x, and also u,d,l,r,f,b equivalents - elsif ($char eq "X" or $char eq "x" or $char eq "r") - {for($j=1;$j<=$m;$j++) {gprint ("...rotation $char OK (= rrR + rrSr + rrLp)"); &rrR;&rrSr;&rrLp}} - elsif ($char eq "Xp" or $char eq "xp" or $char eq "l") - {for($j=1;$j<=$m;$j++) {gprint ("...rotation $char OK (= rrRp + rrSrp + rrL)");&rrRp;&rrSrp;&rrL}} - elsif ($char eq "Y" or $char eq "y" or $char eq "u") - {for($j=1;$j<=$m;$j++) {gprint ("...rotation $char OK (= rrU + rrSu + rrDp)"); &rrU;&rrSu;&rrDp}} - elsif ($char eq "Yp" or $char eq "yp" or $char eq "d") - {for($j=1;$j<=$m;$j++) {gprint ("...rotation $char OK (= rrUp + rrSup + rrD)");&rrUp;&rrSup;&rrD}} - elsif ($char eq "Z" or $char eq "z" or $char eq "f") - {for($j=1;$j<=$m;$j++) {gprint ("...rotation $char OK (= rrF + rrSf + rrBp)"); &rrF;&rrSf;&rrBp}} - elsif ($char eq "Zp" or $char eq "zp" or $char eq "b") - {for($j=1;$j<=$m;$j++) {gprint ("...rotation $char OK (= rrFp + rrSfp + rrB)");&rrFp;&rrSfp;&rrB}} - ## extras - elsif ($char eq "M") {for($j=1;$j<=$m;$j++) {gprint ("...rotation M OK (= Sl) "); &rrSl}} - elsif ($char eq "Mp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Mp OK (= Sr) "); &rrSr}} - elsif ($char eq "E") {for($j=1;$j<=$m;$j++) {gprint ("...rotation E OK (= Sd) "); &rrSd}} - elsif ($char eq "Ep") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ep OK (= Su) "); &rrSu}} - elsif ($char eq "S") {for($j=1;$j<=$m;$j++) {gprint ("...rotation S OK (= Sf) "); &rrSf}} - elsif ($char eq "Sp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sp OK (= Sb) "); &rrSb}} + elsif ($rcode eq "D") {for($j=1;$j<=$m;$j++) {gprint ("...rotation D, OK (= Dp3)"); &rrD}} + elsif ($rcode eq "Dp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dp, OK "); &rrDp}} + elsif ($rcode eq "Dw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dw, OK (= Dp3 + Sup)"); &rrDw}} + elsif ($rcode eq "Dwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dwp, OK (= Dp + Su)"); &rrDwp}} + elsif ($rcode eq "Ds") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ds, OK (= D + Up)"); &rrDs}} + elsif ($rcode eq "Dsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dsp, OK (= Dp + U)"); &rrDsp}} + elsif ($rcode eq "Da") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Da, OK (= D + U)"); &rrDa}} + elsif ($rcode eq "Dap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Dap, OK (= Dp + Up)"); &rrDap}} #### - ## check for missing rotation - elsif ($char eq "") {for($j=1;$j<=$m;$j++) - {gprint ("...rotation ,$char, ERROR ? typo or missing rotation"), - errormessage("[,$char,] in RubikRotation: ? typo or missing rotation")}} + elsif ($rcode eq "F") {for($j=1;$j<=$m;$j++) {gprint ("...rotation F, OK"); &rrF}} + elsif ($rcode eq "Fp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fp, OK (= F3)"); &rrFp}} + elsif ($rcode eq "Fw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fw, OK (= F + Sf)"); &rrFw}} + elsif ($rcode eq "Fwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fwp, OK (= Fp + Sfp)"); &rrFwp}} + elsif ($rcode eq "Fs") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fs, OK (= F + Bp)"); &rrFs}} + elsif ($rcode eq "Fsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fsp, OK (= Fp + B)"); &rrFsp}} + elsif ($rcode eq "Fa") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fa, OK (= F + B)"); &rrFa}} + elsif ($rcode eq "Fap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Fap, OK (= Fp + Bp)"); &rrFap}} #### - ## rotation must be undefined + elsif ($rcode eq "B") {for($j=1;$j<=$m;$j++) {gprint ("...rotation B, OK (= Fp3)"); &rrB}} + elsif ($rcode eq "Bp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bp, OK"); &rrBp}} + elsif ($rcode eq "Bw") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bw, OK (= Fp3 + Sfp)"); &rrBw}} + elsif ($rcode eq "Bwp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bwp, OK (= Fp + Sf)"); &rrBwp}} + elsif ($rcode eq "Bs") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bs, OK (= B + Fp)"); &rrBs}} + elsif ($rcode eq "Bsp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bsp, OK (= Bp + F)"); &rrBsp}} + elsif ($rcode eq "Ba") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ba, OK (= B + F)"); &rrBa}} + elsif ($rcode eq "Bap") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Bap, OK (= Bp + Fp)"); &rrBap}} + + #### -------------------------------------- + + #### inner-slice (= middle slice) + ## need to include MES (middle slice) notation + elsif ($rcode eq "M") {for($j=1;$j<=$m;$j++) {gprint ("...rotation M, OK (= Sl) "); &rrSl}} + elsif ($rcode eq "Mp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Mp, OK (= Sr) "); &rrSr}} + elsif ($rcode eq "E") {for($j=1;$j<=$m;$j++) {gprint ("...rotation E, OK (= Sd) "); &rrSd}} + elsif ($rcode eq "Ep") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Ep, OK (= Su) "); &rrSu}} + elsif ($rcode eq "S") {for($j=1;$j<=$m;$j++) {gprint ("...rotation S, OK (= Sf) "); &rrSf}} + elsif ($rcode eq "Sp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sp, OK (= Sb) "); &rrSb}} + + #### middle slice rotations (Singmaster) + elsif ($rcode eq "Su") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Su, OK "); &rrSu}} + elsif ($rcode eq "Sup") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sup, OK (= Su3)"); &rrSup}} + elsif ($rcode eq "Sd") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sd, OK (= Sup)"); &rrSd}} + elsif ($rcode eq "Sdp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sdp, OK (= Su)"); &rrSdp}} + elsif ($rcode eq "Sl") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sl, OK (= Srp)"); &rrSl}} + elsif ($rcode eq "Slp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Slp, OK (= Sr)"); &rrSlp}} + elsif ($rcode eq "Sr") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sr, OK"); &rrSr}} + elsif ($rcode eq "Srp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Srp, OK (= Sr3)"); &rrSrp}} + elsif ($rcode eq "Sf") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sf, OK"); &rrSf}} + elsif ($rcode eq "Sfp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sfp, OK (= Sf3)"); &rrSfp}} + elsif ($rcode eq "Sb") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sb, OK (= Sfp)"); &rrSb}} + elsif ($rcode eq "Sbp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation Sbp, OK (= Sf)"); &rrSbp}} + + ## need to include Jaap Puzzles website for middle slice notation (Lm, Lmp) + ## also include Randelshofer website middle slice notation (ML,MLp..) + + elsif ($rcode eq "ML" or $rcode eq "MRp" or $rcode eq "Lm" or $rcode eq "Rmp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Lm = M = Sl) "); &rrSl}} + + elsif ($rcode eq "MR" or $rcode eq "MLp" or $rcode eq "Rm" or $rcode eq "Lmp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Rm = Mp = Sr) "); &rrSr}} + + elsif ($rcode eq "MU" or $rcode eq "MDp" or $rcode eq "Um" or $rcode eq "Dmp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Um = Ep = Su) "); &rrSu}} + + elsif ($rcode eq "MD" or $rcode eq "MUp" or $rcode eq "Dm" or $rcode eq "Ump") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Dm = E = Sd) "); &rrSd}} + + elsif ($rcode eq "MF" or $rcode eq "MBp" or $rcode eq "Fm" or $rcode eq "Bmp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Fm = S = Sf) "); &rrSf}} + + elsif ($rcode eq "MB" or $rcode eq "MFp" or $rcode eq "Bm" or $rcode eq "Fmp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Bm = Sp = Sb) "); &rrSb}} + ##---------------------------------- + + #### double outer slice (wide) notation + #### need to include Randelshofer TL, TLp double outer slice notation + #### (equiv to the w wide notation) + elsif ($rcode eq "TL") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TL, OK (= Lw = Lp3 + Srp)"); &rrLw}} + elsif ($rcode eq "TLp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TLp, OK (= Lwp = Lp + Sr)"); &rrLwp}} + elsif ($rcode eq "TR") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TR, OK (= Rw = R + Sr)"); &rrRw}} + elsif ($rcode eq "TRp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TRp, OK (= Rwp = Rp + Srp)"); &rrRwp}} + elsif ($rcode eq "TU") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TU, OK (= Uw = U + Su)"); &rrUw}} + elsif ($rcode eq "TUp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TUp, OK (= Uwp = Up + Sup)"); &rrUwp}} + elsif ($rcode eq "TD") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TD, OK (= Dw = Dp3 + Sup)"); &rrDw}} + elsif ($rcode eq "TDp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TDp, OK (= Dwp = Dp + Su)"); &rrDwp}} + elsif ($rcode eq "TF") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TF, OK (= Fw = F + Sf)"); &rrFw}} + elsif ($rcode eq "TFp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TFp, OK (= Fwp = Fp + Sfp)"); &rrFwp}} + elsif ($rcode eq "TB") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TB, OK (= Bw = Fp3 + Sfp)"); &rrBw}} + elsif ($rcode eq "TBp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation TBp, OK (= Bwp = Fp + Sf)"); &rrBwp}} + + + ## --------------------------- + ## opposite slice notation of Randelshofer (SR, SRp) (= standard Rs, Rsp) + ## opposite outer slices rotated in SAME direction as the FACE + + elsif ($rcode eq "SL") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Ls = L + Rp)"); &rrLs}} + elsif ($rcode eq "SLp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Lsp = Lp + R)"); &rrLsp}} + + elsif ($rcode eq "SR") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Rs = R + Lp)"); &rrRs}} + elsif ($rcode eq "SRp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Rsp = Rp + L)"); &rrRsp}} + + elsif ($rcode eq "SU") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Us = U + Dp)"); &rrUs}} + elsif ($rcode eq "SUp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Usp = Up + D)"); &rrUsp}} + + elsif ($rcode eq "SD") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Ds = D + Up)"); &rrDs}} + elsif ($rcode eq "SDp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Dsp = Dp + U)"); &rrDsp}} + + + elsif ($rcode eq "SF") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Fs = F + Bp)"); &rrFs}} + elsif ($rcode eq "SFp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Fsp = Fp + B)"); &rrFsp}} + + elsif ($rcode eq "SB") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Bs = B + Fp)"); &rrBs}} + elsif ($rcode eq "SBp") {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= Bsp = Bp + F)"); &rrBsp}} + + + ## ------------------------- + + ## whole cube rotations + ## need to include x,y,z (upper and lowercase) and also u,d,l,r,f,b (lowercase only) equivalents + elsif ($rcode eq "X" or $rcode eq "x" or $rcode eq "r") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= x = R + Sr + Lp)"); &rrR;&rrSr;&rrLp}} + elsif ($rcode eq "Xp" or $rcode eq "xp" or $rcode eq "l") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= xp = Rp + Srp + L)");&rrRp;&rrSrp;&rrL}} + elsif ($rcode eq "Y" or $rcode eq "y" or $rcode eq "u") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= y = U + Su + Dp)"); &rrU;&rrSu;&rrDp}} + elsif ($rcode eq "Yp" or $rcode eq "yp" or $rcode eq "d") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= yp = Up + Sup + D)");&rrUp;&rrSup;&rrD}} + elsif ($rcode eq "Z" or $rcode eq "z" or $rcode eq "f") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= z = F + Sf + Bp)"); &rrF;&rrSf;&rrBp}} + elsif ($rcode eq "Zp" or $rcode eq "zp" or $rcode eq "b") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode, OK (= zp = Fp + Sfp + B)");&rrFp;&rrSfp;&rrB}} + + ## more whole cube notation + ## need to include Jaap website whole cube Lc notation + ## also include Randelshofer C notation (CL, CLp.) + + elsif ($rcode eq "CL" or $rcode eq "CRp" or $rcode eq "Lc" or $rcode eq "Rcp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Lc = xp = Rp + Srp + L)");&rrRp;&rrSrp;&rrL}} + + elsif ( $rcode eq "CR" or $rcode eq "CLp" or $rcode eq "Rc" or $rcode eq "Lcp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Rc = x = R + Sr + Lp)"); &rrR;&rrSr;&rrLp}} + + elsif ($rcode eq "CU" or $rcode eq "CDp" or $rcode eq "Uc" or $rcode eq "Dcp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Uc = y = U + Su + Dp)"); &rrU;&rrSu;&rrDp}} + + elsif ($rcode eq "CD" or $rcode eq "CUp" or $rcode eq "Dc" or $rcode eq "Ucp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Dc = yp = Up + Sup + D)");&rrUp;&rrSup;&rrD}} + + elsif ($rcode eq "CF" or $rcode eq "CBp" or $rcode eq "Fc" or $rcode eq "Bcp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Fc = z = F + Sf + Bp)"); &rrF;&rrSf;&rrBp}} + + elsif ($rcode eq "CB" or $rcode eq "CFp" or $rcode eq "Bc" or $rcode eq "Fcp") + {for($j=1;$j<=$m;$j++) {gprint ("...rotation $rcode OK (= Bc = zp = Fp + Sfp + B)");&rrFp;&rrSfp;&rrB}} + + ## ----------------------------- + + ## check empty string --> missing rotation + elsif ($rcode eq "") {for($j=1;$j<=$m;$j++) + { + gprint ("..*rotation ,$rcode, ERROR ? typo or missing rotation"); + ErrorMessage(",$rcode, -- ? typo or missing rotation"); + } + } + ## finally ---------------------- else { - gprint ("...rotation $originalchar NOT KNOWN"); - errormessage("[$originalchar] in RubikRotation\{\}"); - }; - }; # end of foreach - }; # end of sub + ## to fall this far then the rotation (char) must be undefined + ## but before we can send these rotation code strings out in ErrorMessages + ## we need to check that they are in the original format. + ## ie., do not have any {;} chars etc. If they do, then we need to + ## translate them back, ie {;} --> (,) etc + + ## we use `originalcode' in the ErrorMessage because the user needs to be + ## shown the `bad' code as it was originally input by the RubikRotation{} command. + + + ## check for code with { ; } and restore to normal syntax + if ( $rcode =~ m/(\{|;|\}|\])/ ) { + $rcode = restorebrackets($rcode); + $originalrcode = restorebrackets($originalrcode); + }; + + + if ( $rcode =~ m/(\(|\)|\[|\])/) { + gprint ("..*rotation $rcode ERROR -- code not known ? missing comma or nested brackets"); + ErrorMessage("$originalrcode -- code not known ? missing comma or nested brackets"); + } + else{ + gprint ("..*rotation $rcode ERROR -- code not known ? typo or missing comma"); + ErrorMessage("$originalrcode -- code not known ? typo or missing comma"); + }; -##--------------------------------------------- -## aNOTE we have defined (as rotation SUBs at the end) just 9 primary rotation transforms, -## rrR, rrSr, rrLp -## rrU, rrSu, rrDp -## rrF, rrSf, rrBp -## and since all the remaining ones are simply combinations of these 9 -## we now define all the other rotation subs in terms of these 9 primary moves. -## do NOT use multiples here: write each rotation separately -## ------------- -## derivative subs from R and Sr and Lp -sub rrRp{&rrR;&rrR;&rrR}; # (=rrR3) -sub rrRw{&rrR; &rrSr}; # (= rrR + rrSr) -sub rrRwp{&rrR;&rrR;&rrR; &rrSr;&rrSr;&rrSr}; # (= rrRp + rrSrp) -sub rrRs{&rrR;&rrLp}; -sub rrRsp{&rrRp;&rrL}; -sub rrRa{&rrR;&rrL}; -sub rrRap{&rrRp;&rrLp}; -#### -sub rrL{&rrLp;&rrLp;&rrLp}; # (= rrLp3) -sub rrLw{&rrLp;&rrLp;&rrLp;&rrSrp}; # (=rrLp3 + rrSrp) -sub rrLwp{&rrLp;&rrSr}; -sub rrLs{&rrL;&rrRp}; -sub rrLsp{&rrLp;&rrR}; -sub rrLa{&rrL;&rrR}; -sub rrLap{&rrLp;&rrRp}; -##------------- -## derivative subs from U -sub rrUp{&rrU;&rrU;&rrU}; # (=rrU3) -sub rrUw{&rrU;&rrSu}; # -sub rrUwp{&rrUp;&rrSup}; -sub rrUs{&rrU;&rrDp}; -sub rrUsp{&rrUp;&rrD}; -sub rrUa{&rrU;&rrD}; -sub rrUap{&rrUp;&rrDp}; -#### -sub rrD{&rrDp;&rrDp;&rrDp}; # (= rrDp3) -sub rrDw{&rrDp;&rrDp;&rrDp;&rrSup}; # (=rrDp3 + rrSup) -sub rrDwp{&rrDp;&rrSu}; -sub rrDs{&rrD;&rrUp}; -sub rrDsp{&rrDp;&rrU}; -sub rrDa{&rrD;&rrU}; -sub rrDap{&rrDp;&rrUp}; -##------------- -## derivative subs from F -sub rrFw{&rrF; &rrSf}; # (= rrF + rrSf) -sub rrFp{ &rrF;&rrF;&rrF}; # (=rrF3) -sub rrFwp{&rrF;&rrF;&rrF; &rrSf;&rrSf;&rrSf}; # (= rrF3 + rrSf3) -sub rrFs{&rrF;&rrBp}; -sub rrFsp{&rrFp;&rrB}; -sub rrFa{&rrF;&rrB}; -sub rrFap{&rrFp;&rrBp}; -#### -sub rrB{&rrBp;&rrBp;&rrBp}; # (= rrBp3) -sub rrBw{&rrBp;&rrBp;&rrBp; &rrSfp}; # (=rrBp3 + rrSfp) -sub rrBwp{&rrBp;&rrSf}; -sub rrBs{&rrB;&rrFp}; -sub rrBsp{&rrBp;&rrF}; -sub rrBa{&rrB;&rrF}; -sub rrBap{&rrBp;&rrFp}; -#### -## bring all the S versions together -sub rrSup{&rrSu;&rrSu;&rrSu}; # (=rrSu3) -sub rrSd{&rrSup}; # (=rrSup) -sub rrSdp{&rrSu}; # (=rrSu) -sub rrSl{&rrSrp}; # (=rrSrp) -sub rrSlp{&rrSr}; # (=rrSr) -sub rrSrp{&rrSr;&rrSr;&rrSr}; # (=rrSr3) -sub rrSfp{&rrSf;&rrSf;&rrSf}; # (=rrSf3) -sub rrSb{&rrSfp}; # (=rrSfp) -sub rrSbp{&rrSf}; # (=rrSf) + # missing comma after random is a common error + if ($originalrcode =~ m/random/i ) { + ErrorMessage("$originalrcode -- ? missing comma after random"); + }; + #----------------------------- + next; + }; #end of else + next; + } # end of sub -##========================================================== -# no of arguments passed to the sub = $#_ (black book p 156) -# parameters passed = $_[0] -sub random{ + +#====================================== + + sub random { + +print " SUB random\n"; + ## scramble randomly using n rotations ## example command = RubikRotation{random,74} ## if no n given (second argument = ""), then use default n=50 ## if second argument is some string (not integer) then --> ERROR ## -## asign numbers to the minimal set of rotations to be used using a hash array list +## assign numbers to the minimal set of rotations to be used using a hash array list ## (perl 5 book page 68) ## ? maybe we should only use the 18 rotations mentioned in Rokicki 2013 paper? ## but here I have included all the S ones too. -my @rrlist= ("U", "Up", "Su", "Sup", - "D", "Dp", "Sd", "Sdp", - "L", "Lp", "Sl", "Slp", - "R", "Rp", "Sr", "Srp", - "F", "Fp", "Sf", "Sfp", - "B", "Bp", "Sb", "Sbp"); +my @rrlist= ("U", "Up", "Um", "Ump", + "D", "Dp", "Dm", "Dmp", + "L", "Lp", "Lm", "Lmp", + "R", "Rp", "Rm", "Rmp", + "F", "Fp", "Fm", "Fmp", + "B", "Bp", "Bm", "Bmp"); my $rrlistnumber=$#rrlist; print " rrlistnumber = $rrlistnumber\n"; @@ -600,21 +1005,23 @@ print " rrlistnumber = $rrlistnumber\n"; ## let default no of random rotations for scrambling = 50 my $defaultn = 50; my $maxn = 200; -## grab the integer passed from the random() command in main -my $s = $_[0]; -if ($s >= $maxn) {$s = $maxn; - gprint ("...WARNING: maximum n = 200"); - errormessage ("random: max n =200 (n=200 was used)")} - elsif ($s == 0) {$s = $defaultn; - gprint ("...WARNING: integer = 0 or not given: using default value 50"); - errormessage ("random: n invalid (n=50 was used)")}; -my @rr; ## array to hold all the random rotations -print " randomising the available rotations\n"; + ## grab the integer passed from the random() command in main + my $s = $_[0]; + if ($s >= $maxn) {$s = $maxn; + gprint ("..*WARNING: maximum n = 200"); + ErrorMessage ("random: max n =200 (n=200 was used)")} + elsif ($s == 0) {$s = $defaultn; + gprint ("..*WARNING: integer = 0 or missing: using default value 50"); + ErrorMessage ("warning: integer n missing or invalid (n=50 was used)")}; -## set the seed for the randomisation (BlackBook p 235) -srand; + my @rr; ## array to hold all the random rotations + print " randomising the available rotations\n"; + + + ## set the seed for the randomisation (BlackBook p 235) + srand; ## now select s numbers at random (with replacement) from range 0--listnumber+1 ## Since we are using int(rand x), and using nos from 0--lastindex number, @@ -634,17 +1041,26 @@ for ($j = 1; $j <=$s; $j=$j+1) ## we assume the user is starting from a solved cube (ie use the state given by user) gprint ("...scrambling Rubik cube using $s random rotations"); + ## now send the array off to the rotation sub - rotation(@rr); -} -##===================subs================================== + my $E; + + foreach $E (@rr) { rotation($E) }; + + } ##end of sub + + +#====================================== + + sub writestate { - sub writestate{ -## this just writes the final state to the TeX_OUT_FILE (= rubikstateNEW.dat) will be read by latex. +print " SUB writestate\n"; -print (TeX_OUT_FILE "\%\% output datafile=$out_file\n"); -print (TeX_OUT_FILE "\%\% PERL prog=rubikrotation version $version\n"); +## this writes the final state to the TeX_OUT_FILE (= rubikstateNEW.dat) will be read by latex. + +print (TeX_OUT_FILE "\%\% ...output datafile=$out_file\n"); +print (TeX_OUT_FILE "\%\% ...PERL script=rubikrotation.pl version $version\n"); print (TeX_OUT_FILE "\\typeout{...writing new Rubik state to file $out_file}\%\n"); print (TeX_OUT_FILE "\\RubikFaceUp\{$Ult[0]\}\{$Umt[0]\}\{$Urt[0]\}\{$Ulm[0]\}\{$Umm[0]\}\{$Urm[0]\}\{$Ulb[0]\}\{$Umb[0]\}\{$Urb[0]\}\%\n"); print (TeX_OUT_FILE "\\RubikFaceDown\{$Dlt[0]\}\{$Dmt[0]\}\{$Drt[0]\}\{$Dlm[0]\}\{$Dmm[0]\}\{$Drm[0]\}\{$Dlb[0]\}\{$Dmb[0]\}\{$Drb[0]\}\%\n"); @@ -653,33 +1069,246 @@ print (TeX_OUT_FILE "\\RubikFaceRight\{$Rlt[0]\}\{$Rmt[0]\}\{$Rrt[0]\}\{$Rlm[ print (TeX_OUT_FILE "\\RubikFaceFront\{$Flt[0]\}\{$Fmt[0]\}\{$Frt[0]\}\{$Flm[0]\}\{$Fmm[0]\}\{$Frm[0]\}\{$Flb[0]\}\{$Fmb[0]\}\{$Frb[0]\}\%\n"); print (TeX_OUT_FILE "\\RubikFaceBack\{$Blt[0]\}\{$Bmt[0]\}\{$Brt[0]\}\{$Blm[0]\}\{$Bmm[0]\}\{$Brm[0]\}\{$Blb[0]\}\{$Bmb[0]\}\{$Brb[0]\}\%\n"); +##-----RWDN 2016---create four new holder commands for separate strings---------- + +## these four names are defined in the rubikrotation.sty file so they can be renewed etc +## SequenceInfo +## SequenceName +## SequenceShort +## SequenceLong + + +## ----RWDN 25 Sept 2016 ---------------------- +## now remove the first and last chars of [name] to output just NAME without [ and ] + +## initialise some variables we shall need + $numberofcharsinstring=0; + $nmiddlecharsinstring=0; + + +##----------SequenceName---------------------------- + +## the SequenceName currently includes the [..] +## need to remove the [] before senting it to LaTeX, +## so need to detect when NAME string itself is empty, eg [] +## so create a variable: + $SequenceNameNew=""; + + $numberofcharsinstring = length $SequenceName; + + +## NEED to create error message if [] and empty string etc + +if ($numberofcharsinstring <= 2) + {$SequenceNameNew = $SequenceName} + else { + + $nmiddlecharsinstring = ($numberofcharsinstring - 2); + ## reassign the string without first and last chars + ### format of substr = (origstring, start possn, no of chars to use) + $SequenceNameNew = substr($SequenceName,1,$nmiddlecharsinstring); + }; + + +print (TeX_OUT_FILE "\\renewcommand\\SequenceName\{$SequenceNameNew\}\%\n"); + +print (TeX_OUT_FILE "\\typeout{...SequenceName = $SequenceNameNew}\%\n"); +#----------------- + + + +#----------SequenceInfo---------------- +## we need to preserve any {} structures in the info string, +## so change { } --> [ ] since +## otherwise they will disappear or cause error when printed in LaTeX + + $SequenceInfo=~ tr/\{/\[/; ## swap { --> [ + $SequenceInfo=~ tr/\}/\]/; ## swap } --> ] + +print (TeX_OUT_FILE "\\renewcommand\\SequenceInfo\{$SequenceInfo\}\%\n"); + +print (TeX_OUT_FILE "\\typeout{...SequenceInfo = $SequenceInfo}\%\n"); +#----------------- + + + +##---------SequenceShort------------------ +## generated in MAIN +## SequenceShort = original argument of \RubikRotation{} /without/ any infoblocks +## therefore it may contain square brackets + +print (TeX_OUT_FILE "\\renewcommand\\SequenceShort\{$SequenceShort\}\%\n"); + +print (TeX_OUT_FILE "\\typeout{...SequenceShort = $SequenceShort}\%\n"); +##----------------------- + + +## now prepare the new LONG rotation sequence for output =(LONG sequence + NO NAME) +## BUT before outputting the string, we need to remove the terminal comma + +$numberofcharsinstring = length $SequenceLong; +$nfrontcharsinstring = $numberofcharsinstring -1; +## reassign the string except the terminal comma +$SequenceLong = substr($SequenceLong,0,$nfrontcharsinstring); + + +#---------- +print (TeX_OUT_FILE "\\renewcommand\\SequenceLong\{$SequenceLong\}\%\n"); + +print (TeX_OUT_FILE "\\typeout{...SequenceLong = $SequenceLong}\%\n"); + + + +##----------------------- + ## now include any error messages generated ## (these are all in an array waiting to be printed out) -if ($erroralert eq "YES") + if ($erroralert eq "YES") { ## write errors to a separate file (just for errors---we append the errrors to end of file) ## the error file (rubikstateERRORS.dat) was created by the TeX file my $ne; #number of errors $ne=$#error; ## number of errors= largest index num since we started at zero - ### do not attach error to a <checkstate> command - if ($rotationcommand eq "checkstate") {} - else { - print (TeX_OUT_FILE "\\typeout{** ERROR: command=$rotationcommand}\%\n"); - print (ERROR_OUT_FILE "** ERROR: $rotationcommand\n"); - }; + + ## do not attach error to a <checkstate> command, since we really want + ## to see the checkstate errors (in the ERROR file) printed AFTER the `rotation' command. + if ($rotationcommand eq "checkstate") {} + else {print (ERROR_OUT_FILE "*ERR cmd= $rotationcommand\n") }; + ## last index number or array = $#arrayname (Black book p 62) my $k; + for ($k=0; $k<=$ne; $k=$k+1) { - print (TeX_OUT_FILE "\\typeout{$error[$k]}\%\n"); - print (ERROR_OUT_FILE "$error[$k]\n"); - }; - }; -print " Perl output file written OK\n"; -} -##=========================================== -##================================================ + ## restore correct brackets etc before outputting to Latex + my $errorstring = $error[$k]; + $errorstring = restorebrackets($errorstring); + + print (TeX_OUT_FILE "\\typeout{$errorstring}\%\n"); + print (ERROR_OUT_FILE "$errorstring\n"); + + }; # end of for + }; # end of IF + print " Perl output file written OK\n"; + + } #end of sub + + +#====================================== + + sub ErrorMessage { + + ## writes the argument as a standard error message to out file + + my $errormess = $_[0]; ## parameter passed to sub + + ## restore correct brackets etc before outputting to Latex + $errormess = restorebrackets($errormess); + + $erroralert = "YES"; ## set error alert flag (for use in out message) + $error[$errornumber] = "*ERR $errormess"; + $errornumber++; ## increment number + }; + + +#====================================== + + sub gprint { + +## prints argument (comments) to screen and also to TeX_OUT_FILE. +## The typeout commands will find its way into the log file when read by latex +## Important to include trailing % for messages written to the TeX_OUT_FILE +## to stop extra <spaces> being seen by TeX. + + my $gmess=$_[0]; + print "$gmess\n"; + print (TeX_OUT_FILE "\\typeout{$gmess}\%\n"); + }; + + +#====================================== + + sub checkstate{ + +print " SUB checkstate\n"; + +## only a simple check -- to see if wrong no of colours being used etc +## uses the cubie colours as used by rubikcube package= ROYGBWX + + gprint ("...checking state of cube"); + + my @cubies=($Ult[0],$Umt[0],$Urt[0], $Ulm[0],$Umm[0],$Urm[0], $Ulb[0],$Umb[0],$Urb[0], + $Dlt[0],$Dmt[0],$Drt[0], $Dlm[0],$Dmm[0],$Drm[0], $Dlb[0],$Dmb[0],$Drb[0], + $Llt[0],$Lmt[0],$Lrt[0], $Llm[0],$Lmm[0],$Lrm[0], $Llb[0],$Lmb[0],$Lrb[0], + $Rlt[0],$Rmt[0],$Rrt[0], $Rlm[0],$Rmm[0],$Rrm[0], $Rlb[0],$Rmb[0],$Rrb[0], + $Flt[0],$Fmt[0],$Frt[0], $Flm[0],$Fmm[0],$Frm[0], $Flb[0],$Fmb[0],$Frb[0], + $Blt[0],$Bmt[0],$Brt[0], $Blm[0],$Bmm[0],$Brm[0], $Blb[0],$Bmb[0],$Brb[0]); + + my $R=0,my $O=0,my $Y=0,my $G=0,my $B=0,my $W=0,my $X=0; + + my $cubiecolour = ""; + + foreach $cubiecolour (@cubies) + { + if ($cubiecolour eq R) {$R = $R+1} + elsif ($cubiecolour eq O) {$O = $O+1} + elsif ($cubiecolour eq Y) {$Y = $Y+1} + elsif ($cubiecolour eq G) {$G = $G+1} + elsif ($cubiecolour eq B) {$B = $B+1} + elsif ($cubiecolour eq W) {$W = $W+1} + elsif ($cubiecolour eq X) {$X = $X+1} + else { + gprint ("..*cubie-colour counting ERROR"); + } + }; + + my $cubiesum=0; + $cubiesum = $R+$O+$Y+$G+$B+$W+$X; + gprint ("...cubiesum = $cubiesum (Red=$R, Or=$O, Ye=$Y, Gr=$G, Bl=$B, Wh=$W, X=$X)"); + + # only generate ErrorMessages if n>9 (as may be using a Grey cube) + if ($cubiesum != 54) { + ErrorMessage ("cubiesum not = 54"); + gprint ("..*cubiesum not = 54") }; + + if ($R >9){ + ErrorMessage("red cubies > 9 (=$R)"); + gprint ("..*red cubies > 9 (=$R)") }; + + if ($O >9){ + ErrorMessage("orange cubies > 9 (=$O)"); + gprint ("..*orange cubies > 9 (=$O)") }; + + if ($Y >9){ + ErrorMessage("yellow cubies > 9 (=$Y)"); + gprint ("..*yellow cubies > 9 (=$Y)") }; + + if ($G >9){ + ErrorMessage("green cubies > 9 (=$G)"); + gprint ("..*green cubies > 9 (=$G)") }; + + if ($B >9){ + ErrorMessage("blue cubies > 9 (=$B)"); + gprint ("..*blue cubies > 9 (=$B)") }; + + if ($W >9){ + ErrorMessage("white cubies > 9 (=$W)"); + gprint ("..*white cubies > 9 (=$W)") }; + + if ($X == 54){ + ErrorMessage("no colours allocated (X=54)"); + gprint ("..*no colours allocated (X=54)") }; + + print " done\n\n"; + }; + + +#====================================== + +## Overview of rotation transform subs + +#====================================== ## The following 9 (90 degree) rotation transformations are used ## to generate all the rotations used in the `rotation sub' ## each of these is a permutation for both colours and numbers @@ -697,13 +1326,18 @@ print " Perl output file written OK\n"; ## two pairs of connected but different permutations/transformations as follows: ## (a) one pair for the 12 Side cubies (arrays = @Xs0 (for Side colours), @Xs1 (for Side numbers)), and ## (b) one pair for the 9 Face cubies (arrays = @Xf0 (for Face colours), @Xf1 (for Face numbers)). -## Each of the center slice rotations (rrSr, rrSu, rrSf) is involved with just one pair of +## Each of the middle slice rotations (rrSr, rrSu, rrSf) is involved with just one pair of ## permutations for the 12 Side cubies (arrays = @Xs0 (for Side colours), @Xs1 (for Side numbers)). -## We document only the side and face of the first sub (rrR) in detail, since the other subs are of similar form. -##================================================ - sub rrR{ +## We document only the side and face of the first sub (rrR) in detail, since +## the other subs are of similar form. +#====================================== -## the R (slice + face) transform + +#====================================== + + sub rrR { + +## the RIGHT (slice + face) transform ## R = RIGHT, s = side; 0=colour, 1= number ## make the clockwise rotation permutation ## In this permutation the Front-right-bottom (Frb) (side)facelet rotates to @@ -711,6 +1345,7 @@ print " Perl output file written OK\n"; ##-----------SIDE------- ## 12 side cubie facelets in arrays @Rs0 (colours) and @Rs1 (numbers) ## these are the initial positions + @Rs0=($Frb[0],$Frm[0],$Frt[0], $Urb[0],$Urm[0],$Urt[0], $Blt[0],$Blm[0],$Blb[0], @@ -729,6 +1364,7 @@ print " Perl output file written OK\n"; ## First line example: ## variable $Urb[0] (Upface-right-bottom colour) <-- colour of first element in @Rs0 (=Frb[0]) ## variable $Urb[1] (Upface-right-bottom number) <-- number of first element in @Rs1 (=Frb[1]) + $Urb[0]=$Rs0[0]; $Urb[1]=$Rs1[0]; $Urm[0]=$Rs0[1]; $Urm[1]=$Rs1[1]; $Urt[0]=$Rs0[2]; $Urt[1]=$Rs1[2]; @@ -746,12 +1382,13 @@ $Frm[0]=$Rs0[10]; $Frm[1]=$Rs1[10]; $Frt[0]=$Rs0[11]; $Frt[1]=$Rs1[11]; ##-------------Right FACE--------------------- -## R FACE (9 cubies in each array) +## RIGHT FACE (9 cubies in each array) ## (numbered in rows: 1,2,3/4,5,6/7,8,9 from top left(1) to bottom right(9)) ## R=Right, f = face; 0=colour, 1= number ## do the Rface (90 degree) rotation transform ## here the Right-left-bottom (Rlb) facelet rotates to the possn of Right-left-top (Rlt) ## we start with two arrays (one for colours @Rf0, one for numbers @Rf1) with 9 elements each. + @Rf0=($Rlb[0], $Rlm[0], $Rlt[0], $Rmb[0], $Rmm[0], $Rmt[0], $Rrb[0], $Rrm[0], $Rrt[0]); @Rf1=($Rlb[1], $Rlm[1], $Rlt[1], $Rmb[1], $Rmm[1], $Rmt[1], $Rrb[1], $Rrm[1], $Rrt[1]); @@ -761,6 +1398,7 @@ $Frt[0]=$Rs0[11]; $Frt[1]=$Rs1[11]; ## First line example: ## variable $Rlt[0] (=Right-left-top colour) <-- colour of first element in @Rf0 (=Rlb[0]) ## variable $Rlt[1] (=Right-left-top number) <-- number of first element in @Rf1 (=Rlb[1]) + $Rlt[0]=$Rf0[0]; $Rlt[1]=$Rf1[0]; $Rmt[0]=$Rf0[1]; $Rmt[1]=$Rf1[1]; $Rrt[0]=$Rf0[2]; $Rrt[1]=$Rf1[2]; @@ -774,10 +1412,13 @@ $Rmb[0]=$Rf0[7]; $Rmb[1]=$Rf1[7]; $Rrb[0]=$Rf0[8]; $Rrb[1]=$Rf1[8]; } -#============================ -sub rrSr { -## Sr = Right middle SLICE rotation (only 12 side facelets) + +#====================================== + + sub rrSr { + +## Sr = RIGHT middle SLICE rotation (only 12 side facelets) ## modified from rrR (change the U,D,F, r --> m and Back Bl-->Bm; Rs--> ?Srs) ## change only the slice ## s = side; 0=colour, 1= number @@ -812,12 +1453,15 @@ $Fmt[0]=$SRs0[11]; $Fmt[1]=$SRs1[11]; } -##=================== -sub rrLp{ -## Left slice (side + face) anticlockwise rotation +#====================================== + + sub rrLp { + +## LEFT slice (side + face) anticlockwise rotation ## s = side; 0=colour, 1= number ##-------------side----------- + @LPs0=($Flb[0],$Flm[0],$Flt[0], $Ulb[0],$Ulm[0],$Ult[0], $Brt[0],$Brm[0],$Brb[0], @@ -847,7 +1491,7 @@ $Flt[0]=$LPs0[11]; $Flt[1]=$LPs1[11]; ##---------------Left FACE------------- -## do the Lface transform (in rows: 1,2,3//4,5,6//7,8,9) +## do the LEFT face transform (in rows: 1,2,3//4,5,6//7,8,9) ## f = face; 0=colour, 1= number ## NOTES: not same as for R @@ -868,15 +1512,16 @@ $Lrb[0]=$LPf0[8]; $Lrb[1]=$LPf1[8]; } -##================================== -##============================== - sub rrU{ +#====================================== -## Up slice (side + face) + sub rrU { + +## UP slice (side + face) ## do the Uside transform ## s = side; 0=colour, 1= number ## ----------SIDE-------------- + @Us0=($Lrt[0],$Lmt[0],$Llt[0], $Brt[0],$Bmt[0],$Blt[0], $Rrt[0],$Rmt[0],$Rlt[0], @@ -907,6 +1552,7 @@ $Llt[0]=$Us0[11]; $Llt[1]=$Us1[11]; ##-------------Up FACE------------------- ## do the Rface transform (in rows: 1,2,3//4,5,6//7,8,9) ## f = face; 0=colour, 1= number + @Uf0=($Ulb[0], $Ulm[0], $Ult[0], $Umb[0], $Umm[0], $Umt[0], $Urb[0], $Urm[0], $Urt[0]); @Uf1=($Ulb[1], $Ulm[1], $Ult[1], $Umb[1], $Umm[1], $Umt[1], $Urb[1], $Urm[1], $Urt[1]); @@ -924,13 +1570,16 @@ $Urb[0]=$Uf0[8]; $Urb[1]=$Uf1[8]; } -##============================== - sub rrSu{ +#====================================== + + sub rrSu { + ## middle slice rotation (side only 12 facelets) ## s = side; 0=colour, 1= number ## make the post rotation permutation ##-----------SIDE------------------- + @SUs0=($Lrm[0],$Lmm[0],$Llm[0], $Brm[0],$Bmm[0],$Blm[0], $Rrm[0],$Rmm[0],$Rlm[0], @@ -961,14 +1610,15 @@ $Llm[0]=$SUs0[11]; $Llm[1]=$SUs1[11]; } -##============================== +#====================================== - sub rrDp{ + sub rrDp { -## Dpwn Face anticlockwise rotation (side and face) +## Down Face anticlockwise rotation (side and face) ## s = side; 0=colour, 1= number ## make the post rotation permutation ##--------------SIDE---------------- + @DPs0=($Lrb[0],$Lmb[0],$Llb[0], $Brb[0],$Bmb[0],$Blb[0], $Rrb[0],$Rmb[0],$Rlb[0], @@ -1015,13 +1665,15 @@ $Drt[0]=$DPf0[8]; $Drt[1]=$DPf1[8]; } -##============================== - sub rrF{ +#====================================== + + sub rrF { ## do the Fside transform (side and face) ## s = side; 0=colour, 1= number ## -----------SIDE----------------- + @Fs0=($Lrb[0],$Lrm[0],$Lrt[0], $Ulb[0],$Umb[0],$Urb[0], $Rlt[0],$Rlm[0],$Rlb[0], @@ -1068,13 +1720,15 @@ $Frb[0]=$Lf0[8]; $Frb[1]=$Lf1[8]; } -##============================== - sub rrSf{ +#====================================== -## do the Fs transform (side only) + sub rrSf { + +## do the FRONT middle slice Fm transform (side only) ## s = side; 0=colour, 1= number ##----------SIDE--------------- + @SFs0=($Lmb[0],$Lmm[0],$Lmt[0], $Ulm[0],$Umm[0],$Urm[0], $Rmt[0],$Rmm[0],$Rmb[0], @@ -1102,14 +1756,16 @@ $Lmm[0]=$SFs0[10]; $Lmm[1]=$SFs1[10]; $Lmt[0]=$SFs0[11]; $Lmt[1]=$SFs1[11]; } -##============================== - - sub rrBp{ + +#====================================== + + sub rrBp { ## Back rotation anticlockwise (side + face) ## do the Bp side transform ## s = side; 0=colour, 1= number ## --------------Side----------------- + @BPs0=($Llb[0],$Llm[0],$Llt[0], $Ult[0],$Umt[0],$Urt[0], $Rrt[0],$Rrm[0],$Rrb[0], @@ -1139,6 +1795,7 @@ $Llt[0]=$BPs0[11]; $Llt[1]=$BPs1[11]; ##-----------------Back FACE------------- ## do the B face transform (in rows: 1,2,3/4,5,6/7,8,9) ## f = face; 0=colour, 1= number + @BPf0=($Brb[0], $Brm[0], $Brt[0], $Bmb[0], $Bmm[0], $Bmt[0], $Blb[0], $Blm[0], $Blt[0]); @BPf1=($Brb[1], $Brm[1], $Brt[1], $Bmb[1], $Bmm[1], $Bmt[1], $Blb[1], $Blm[1], $Blt[1]); @@ -1155,4 +1812,791 @@ $Brb[0]=$BPf0[6]; $Brb[1]=$BPf1[6]; $Bmb[0]=$BPf0[7]; $Bmb[1]=$BPf1[7]; $Blb[0]=$BPf0[8]; $Blb[1]=$BPf1[8]; } -##=====================end=================================== + + +#====================================== + + +#====================================== + +## Overview of derivative transform subs + +#====================================== + +##--------------------------------------------- +## Note that we have defined (as rotation SUBs above) just 9 primary rotation transforms: +## (x axis): rrR, rrSr, rrLp +## (y axis): rrU, rrSu, rrDp +## (z axis): rrF, rrSf, rrBp +## and since all remaining possible rotations are simply combinations of these 9 +## we now define all the other rotation subs in terms of these 9 primary rotations. +## Do NOT use multiples here: write each rotation separately +## ---------------- +## NB: the Sr, Su, Sf are the middle slice rotations (= Rm, Um, Fm respectively) +## (the `m' notation is much more intuitive than the S., but too late to change notation now) +## ------------- + +## ----derivative subs from R and Sr and Lp---- +sub rrRp{&rrR;&rrR;&rrR}; # (=rrR3) +sub rrRw{&rrR; &rrSr}; # (= rrR + rrSr) +sub rrRwp{&rrR;&rrR;&rrR; &rrSr;&rrSr;&rrSr}; # (= rrRp + rrSrp) +sub rrRs{&rrR;&rrLp}; +sub rrRsp{&rrRp;&rrL}; +sub rrRa{&rrR;&rrL}; +sub rrRap{&rrRp;&rrLp}; + +## --------------------- +sub rrL{&rrLp;&rrLp;&rrLp}; # (= rrLp3) +sub rrLw{&rrLp;&rrLp;&rrLp;&rrSrp}; # (=rrLp3 + rrSrp) +sub rrLwp{&rrLp;&rrSr}; +sub rrLs{&rrL;&rrRp}; +sub rrLsp{&rrLp;&rrR}; +sub rrLa{&rrL;&rrR}; +sub rrLap{&rrLp;&rrRp}; + +## ----derivative subs from U ---- +sub rrUp{&rrU;&rrU;&rrU}; # (=rrU3) +sub rrUw{&rrU;&rrSu}; # +sub rrUwp{&rrUp;&rrSup}; +sub rrUs{&rrU;&rrDp}; +sub rrUsp{&rrUp;&rrD}; +sub rrUa{&rrU;&rrD}; +sub rrUap{&rrUp;&rrDp}; + +## --------------------- +sub rrD{&rrDp;&rrDp;&rrDp}; # (= rrDp3) +sub rrDw{&rrDp;&rrDp;&rrDp;&rrSup}; # (=rrDp3 + rrSup) +sub rrDwp{&rrDp;&rrSu}; +sub rrDs{&rrD;&rrUp}; +sub rrDsp{&rrDp;&rrU}; +sub rrDa{&rrD;&rrU}; +sub rrDap{&rrDp;&rrUp}; + +## ----derivative subs from F ---- +sub rrFw{&rrF; &rrSf}; # (= rrF + rrSf) +sub rrFp{ &rrF;&rrF;&rrF}; # (=rrF3) +sub rrFwp{&rrF;&rrF;&rrF; &rrSf;&rrSf;&rrSf}; # (= rrF3 + rrSf3) +sub rrFs{&rrF;&rrBp}; +sub rrFsp{&rrFp;&rrB}; +sub rrFa{&rrF;&rrB}; +sub rrFap{&rrFp;&rrBp}; + +## --------------------- +sub rrB{&rrBp;&rrBp;&rrBp}; # (= rrBp3) +sub rrBw{&rrBp;&rrBp;&rrBp; &rrSfp}; # (=rrBp3 + rrSfp) +sub rrBwp{&rrBp;&rrSf}; +sub rrBs{&rrB;&rrFp}; +sub rrBsp{&rrBp;&rrF}; +sub rrBa{&rrB;&rrF}; +sub rrBap{&rrBp;&rrFp}; + +## ----bring all the S versions together ---- +sub rrSup{&rrSu;&rrSu;&rrSu}; # (=rrSu3) +sub rrSd{&rrSup}; # (=rrSup) +sub rrSdp{&rrSu}; # (=rrSu) +sub rrSl{&rrSrp}; # (=rrSrp) +sub rrSlp{&rrSr}; # (=rrSr) +sub rrSrp{&rrSr;&rrSr;&rrSr}; # (=rrSr3) +sub rrSfp{&rrSf;&rrSf;&rrSf}; # (=rrSf3) +sub rrSb{&rrSfp}; # (=rrSfp) +sub rrSbp{&rrSf}; # (=rrSf) + + + +#====================================== + + sub rubikmod { + + ## for MODifying (MOD 4) +print " SUB rubikmod\n"; + ## passing one RotationElement as a parameter, & return a modified one + ## make local variables + + + my $rot=""; + my $lencode=""; + my $char=""; + my $m4=-1; + my $num=-1; + my $p=0; + + + # grab the parameter string + # $code = @_[0]; + $code = $_[0]; ## Perl says this is better + + $lencode=length $code; + + ## we want to split the code string into the front (Rubikcode) and terminal number + ## so grab 1 char sequentially starting from the end of the string + ## and identify the position of the first non-digit char we get to + ## example: $lastchar = substr $code,-1,1 ; + for ($p=-1; $p>-$lencode-1; $p=$p-1){ + $char = substr $code,$p,1 ; + if ($char =~ /\d/) {} + else{ + ## this char is the first non-digit from the end" + ## its position = $p + last; + }; + }; + + ## now use the value of $p to split the code string + ## into front part (= $rot) and back part (= $num) + + ## get $rot + $rot = substr $code, 0, ($lencode + $p + 1); + + ## get $num + $num = substr $code, $lencode +$p +1, ($lencode -(length $rot)); + + ##-------------- + ## if no number at all (eg D) then this Rubikcode needs to be implemented just once + ## so allocate its num to have value = 1 + + ## if ($num == ""){$num=1}; ## BUT this gives an ErrorMessage when num="" etc + ## so I have rewritten [if numlength --> 0 then..] then it works OK + + $numlength = ($lencode -(length $rot)); + if ($numlength == 0) {$num=1}; + ##--------------------- + + ## determine mod 4 of the value num + $m4 = $num % 4; + + ## now return the results + $rotcode=$rot; + $rotnumber=$num; ## we return this so we can use it as a check + $modnumber=$m4; + + return $rotcode, $rotnumber, $modnumber; + + } #end of sub + + +#====================================== + + sub cleanstring { + + # to clean leading and trailing whitespace from a string + + my $line=""; + + $line = $_[0]; # copied from my RubikMOD() + + #clean leading & trailing whitespace + + $line =~ s/^\s+//; ## clean leading whitespace + $line =~ s/\s+$//; ## clean trailing whitespace + + return $line; + } + + +#====================================== + + sub cutinfoblock { + + ## remove each <infoblock> if any exists + + ## pass the whole dataline + + print " SUB cutinfoblock\n"; + + my $dataline = $_[0]; + + ## we know all brackets are balanced - as this has been checked already. + + print " dataline = $dataline\n"; + my $Langle=0; + my $Rangle=0; + my $angleblock=""; + my $lenangleblock=0; + + ## first see if there is a terminal infoblock + $Langle = index $dataline, '<'; ## < + $Rangle = index $dataline, '>'; ## < + $lenangleblock = $Rangle - $Langle +1; + + ##----------------- + ## angleblock is the whole block <...> including both angles + ## check both angles exist + if ( ($Langle !=-1) and ($Rangle !=-1) ) + { + + my $angleblock = substr ($dataline, $Langle, $lenangleblock); + print " infoblock(s) present: first = $angleblock\n"; + + my $lenangleblock = length $angleblock; + my $lendataline = length $dataline; + + + # now need to remove the infoblock from $dataline + # need to get front and back strings + my $frontstring=""; + my $newfrontstring=""; + my $backstring=""; + + $lenbackstring= $lendataline - $Rangle -1; + $frontstring = substr ($dataline,0, $Langle); # string before Langle + $backstring = substr ($dataline,$Rangle +1); # string beyond Rangle + + print " Langle possn = $Langle\n"; + print " Rangle possn = $Rangle\n"; + print " lenangleblock (diff + 1) = $lenangleblock\n"; + print " lendataline = $lendataline\n"; + print " lenbackstring = $lenbackstring\n"; + print " frontstring = $frontstring\n"; + + #remove the terminal comma from front string + $newfrontstring = substr($frontstring, 0, $Langle -1); + print " new frontstring = $newfrontstring\n"; + print " backstring = $backstring\n"; + + ##------- + # remove angleblock from dataline (join front and back strings) + $newdataline =$newfrontstring.$backstring; + + $SequenceInfo = substr ($angleblock, 1, $lenangleblock -2); + + print " new dataline = $newdataline\n"; + print " SequenceInfo = $SequenceInfo\n"; + print " newdataline = $newdataline\n"; + print " done\n\n"; + + return $SequenceInfo, $newdataline; + } + + else{ + # no infoblock, so need to make newdataline same as orig dataline + $newdataline=$dataline; + print " no <infoblock> to remove.\n\n"; + return $newdataline; + }; + #----------------- + + + } ## end of sub + + +#====================================== + + sub fixrepeatelement { + + print " SUB fixrepeatelement\n"; + + print " reformatting any repeat elements...\n"; + + ## this sub replaces ,-->; and (--> { and ) --> } for the repeat element + ## and inserts it back into the original rotation sequence, where it now + ## appears as a separate rotation element. + + my $repeatstring=""; + my $lenrepeatstring=""; + my $newrepeatstring=""; + my $frontstring=""; + my $backstring=""; + my $p=0; + my $q=0; + my $len = 0; + my $k1=0; + my $k2 = 0; + + + ## pass the whole dataline without the keyword + my $dataline = $_[0]; # copied from my RubikMOD() + + + $p = index $dataline, '('; + $q = index $dataline, ')'; + + print " p = $p, q = $q\n"; + + + $lenrepeatstring = $q -$p +1 ; + $repeatstring = substr ($dataline, $p, $lenrepeatstring); + + print " first repeat string = $repeatstring\n"; + print " length of repeat string = $lenrepeatstring\n"; + + ## translate the chars + $repeatstring =~ tr/,/;/; ## swap , --> ; Black book page 138--139 + $repeatstring =~ tr/\(/\{/; ## swap ( --> { + $repeatstring =~ tr/\)/\}/; ## swap ) --> } + + $newrepeatstring = $repeatstring; + + print "...new repeat string = $newrepeatstring\n"; + + #------------ + $k1=$p; #start of cut + $k2= $p + $lenrepeatstring; #end of cut + $frontstring = substr ($dataline,0, $k1); + $backstring = substr ($dataline,$k2); + print " frontstring = $frontstring\n"; + print " backstring = $backstring\n"; + + # add insert + $newdataline =$frontstring.$newrepeatstring.$backstring; + print " new dataline = $newdataline\n"; + + + print " done\n\n"; + + } # end of sub + + +#====================================== + + sub repeat { + + # to expand the repeating elements + +print " SUB repeat\n"; + + ## pass the whole repeatstring = {...}n + my $repeatstring = $_[0]; + + # the string ={code}n + # get the code sequence and the terminal digit + + my $p=0; + my $q=0; + my $repeatnumber=0; + my $repeatcode=""; + my $lenrepeatcode =0; + + $p = index $repeatstring, '{'; + $q = index $repeatstring, '}'; + $lenrepeatcode = $q - $p -1; + + + + $repeatcode = substr ($repeatstring,1,$lenrepeatcode); + print " repeatcode = $repeatcode\n"; ## correct + + + $lenrepeatstring= length $repeatstring; + + + print " lenrepeatstring = $lenrepeatstring\n"; + print " lenrepeatcode = $lenrepeatcode\n"; + print " p = $p\n"; + print " q = $q\n"; + + + if ($lenrepeatcode == ($lenrepeatstring-2)) { + print " there is no trailing number --> 1\n"; + $repeatnumber=1; + print " set repeatnumber = $repeatnumber\n"; + } + else{ + $repeatnumber= substr ($repeatstring, $q + 1); # correct + print " repeatnumber = $repeatnumber\n"; + + ## need to check that repeatnumber is a valid integer + if ($repeatnumber =~ /\D/){ + # not a valid number + + ## renormalise brackets etc before outputting to LaTeX + $repeatnumber= restorebrackets($repeatnumber); + + gprint ("..*repeat-no. ERROR: $repeatnumber not numeric"); + ErrorMessage ("repeat-no. $repeatnumber not numeric ?missing comma or nested ()"); + }; + + }; #end of else + + + ## make n copies of repeatcode + ## we need commas only between elements (not at end) + + $insert=""; ## $insert = global + $insert=$repeatcode; + for ($t=1; $t < $repeatnumber; $t=$t+1) {$insert=$insert.",".$repeatcode}; + + print " insert = $insert\n"; + print " done\n\n"; + + } # end sub + + +#====================================== + + sub quitprogram { + + ## exiting the program cleanly + print " closing down: writing state...\n"; + writestate(); ## write to the output files + close; ## close all files + exit; + } + + +#====================================== + + sub showarray { + + # show the array as a string + + my @newarray = @_; # copied from my RubikMOD() + my $arraystring= join (",",@newarray); + print " the array = *$arraystring*\n\n"; + } + + +#====================================== + + sub cleanarray { + + # cleans array elements of leading and trailing whitespace + + my @cleanset=(); + my @line = @_; + my $E; + + foreach $E (@line) { + $E =~ s/^\s+//; ## clean leading whitespace + $E =~ s/\s+$//; ## clean trailing whitespace + push @cleanset, $E; + }; + + return @cleanset; + +} + + +#====================================== + + sub restorebrackets { + + my $line = $_[0]; + + ## translate the chars + $line =~ tr/;/,/; ## swap , --> ; Black book page 138--139 + $line =~ tr/\{/\(/; ## swap ( --> { + $line =~ tr/\}/\)/; ## swap ) --> } + + return $line; + +} + + +#====================================== + + sub infoblockcolon { + + print "...SUB InfoblockColon\n"; + + ## pass the whole dataline without the keyword + my $line = $_[0]; # copied from my RubikMOD() + + if ( (index $line, '<' ) == -1) { + # no infoblock, so need to make newdataline same as orig dataline + print " no <infoblock> found.\n\n"; + $newdataline=$dataline; + return $newdataline; + } + else{ + print " infoblock(s) present\n"; + + print " start-string = $line\n"; + + # look at each char + my $j=0; + my $char=""; + + my $lenstring = 0; + $lenstring= length $line; + + # set initial state of inout-flag + my $inoutflag="outside"; + + #------------------------ + for ($j=0; $j<=$lenstring; $j=$j+1) { + $char = substr ($line,$j,1); + + if ( ($char eq ',') and ($inoutflag eq 'inside')) { + # replace the char with ; + substr ($line, $j, 1, ";"); + print " colon-string = $line\n"; + }; + + ## need these at end of the loop + if ($char eq '<'){$inoutflag = "inside"}; + if ($char eq '>'){$inoutflag = "outside"}; + + }; # end of for + + #--------------------------- + + # -- repeat for [ ] brackets------ + $inoutflag="outside"; + + for ($j=0; $j<=$lenstring; $j=$j+1) { + $char = substr ($line,$j,1); + + if ( ($char eq ',') and ($inoutflag eq 'inside')) { + # replace the char with ; + substr ($line, $j, 1, ";"); + print " colon-string = $line\n"; + }; + + ## need these at end of the loop + if ($char eq '['){$inoutflag = "inside"}; + if ($char eq ']'){$inoutflag = "outside"}; + + }; # end of for + + + #---------------------------------- + ## make an array from the string so we can manipulate the elements + our @linedata=(); + @linedata= split (/,/, $line); + +#----------clean the array------- + my $E; + my @cleandata=(); + + foreach $E (@linedata) { + $E =~ s/^\s+//; ## clean leading whitespace + $E =~ s/\s+$//; ## clean trailing whitespace + push @cleandata, $E; + }; + + print " colon-array = @cleandata\n"; + +#================= + +# Because <infoblocks> can be located inside curved brackets +# as for example, (\sixspot)2, [\sixspot macro contains an infoblock]. +# Consequently, we need to remove +# the <..> blocks as parts of a string, not as elements in an array. +# --otherwise, removing the terminal infoblock associated with \sixspot +# will result in also removing the right-hand curved bracket --> error. +# So we return the data as a string, and then send it to sub cutinfoblock later. + + $newdataline = join (",", @cleandata); + print "...done\n\n"; + + return $newdataline; + + } ## end of else + } ## end of sub + + +#====================================== + + sub RemoveAllSpaces { + + # remove all spaces in a string + # Black book page 143 + + my $string=$_[0]; + + $string =~ s/\s//g; # OK + + return $string; + +} + +#====================================== + +sub CheckSyntax { + + ## checks that all () {} <> are matched (if any exist) + ## checks for other syntax problems, eg missing commas + ## if any brackets are not balanced, then we SET an errorflag, and terminate the program + + print " SUB CheckSyntax\n"; + + my $dataline = $_[0]; + + # first clean out all spaces so we can look for specific strings + $dataline=RemoveAllSpaces($dataline); + + print " dataline = $dataline\n"; + + + + + ## count brackets; Angle, Square, Curved + my ($nleftA, $nrightA) = 0; + my ($nleftS, $nrightS) = 0; + my ($nleftC, $nrightC) = 0; + my ($leftsum, $rightsum) =0; + + ## Blackbook p 139 - counting chars in a string + $nleftA = ($dataline =~ tr/</</); + $nrightA = ($dataline =~ tr/>/>/); + + $nleftS = ($dataline =~ tr/[/[/); + $nrightS = ($dataline =~ tr/]/]/); + + $nleftC = ($dataline =~ tr/(/(/); + $nrightC = ($dataline =~ tr/)/)/); + + print " left and right <> = $nleftA, $nrightA\n"; + print " left and right [] = $nleftS, $nrightS\n"; + print " left and right () = $nleftC, $nrightC\n"; + + + $leftsum = $nleftA + $nleftS + $nleftC; + $rightsum =$nrightA + $nrightS + $nrightC; + + print " leftsum, rightsum = $leftsum, $rightsum\n"; + + # define the current rotation command before any ErrorMessages are issued + # $rotationcommand=$dataline; ## used in writestate sub + + my $errorflag = ""; + + if ($leftsum != $rightsum) + { + + if ( $nleftS != $nrightS ) + { + gprint ("..*brackets ERROR [ ] Left [$nleftS not equal to Right $nrightS]"); + ErrorMessage ("brackets [ ]: Left [$nleftS not equal to Right $nrightS]"); + $errorflag="SET"; + } + + if ( $nleftC != $nrightC ) + { + gprint ("..*brackets ERROR ( ) Left ($nleftC not equal to Right $nrightC)"); + ErrorMessage ("brackets ( ): Left ($nleftC not equal to Right $nrightC)"); + $errorflag="SET"; + } + + if ( $nleftA != $nrightA ) + { + gprint ("..*brackets ERROR < > Left <$nleftA not equal to Right $nrightA>"); + ErrorMessage ("brackets < >: Left <$nleftA not equal to Right $nrightA>"); + $errorflag="SET"; + } + + }; + + #-------------------------- + + + + # check for other bad syntax + # BB p136 + + my ($char1, $char2, $charpair) = ""; + my ($j, $lenstring) = 0; + $lenstring= length $dataline; + print "lenstring = $lenstring\n"; + + # set initial state of inout-flag + my $angleflag = "outside"; + my $squareflag = "outside"; + my $curvedflag = "outside"; + + # look at each char + for ($j=0; $j<= $lenstring; $j=$j+1) { + $charpair = substr ($dataline,$j,2); + $char1 = substr ($dataline,$j,1); + $char2 = substr ($dataline,$j+1,1); + + ## at top of for loop + if ($char1 eq '<'){$angleflag = "inside"}; + if ($char1 eq '>'){$angleflag = "outside"}; + if ($char1 eq '['){$squareflag = "inside"}; + if ($char1 eq ']'){$squareflag = "outside"}; + if ($char1 eq '('){$curvedflag = "inside"}; + if ($char1 eq ')'){$curvedflag = "outside"}; + + + if ($angleflag eq "outside"){ + + ## A-Za-z< A-Za-z[ A-Za-z( )A-Za-z >A-Za-z ]A-Za-z + ## ]< ][ ]( ]) ]< )< )[ )( >< >[ >( d( d[ d< + + if ( $charpair =~ m/([A-Za-z]\<|[A-Za-z]\[|[A-Za-z]\(|\)[A-Za-z]|\>[A-Za-z]|\][A-Za-z]|\]\<|\]\[|\]\(|\]\)|\]\<|\)\<|\)\[|\)\(|\>\<|\>\[|\>\(|\d\(|\d\[|\d\<|\[\[|\<\<|\(\(|\)\)|\]\]|\>\>)/ ) + { + gprint ("..*syntax error: $charpair -- missing comma"); + ErrorMessage("$charpair -- syntax error: missing comma"); + $errorflag="SET"; + next; + }; + + # trap nested curved brackets + if ( ($char2 eq "(" ) and ($curvedflag eq "inside" ) ) { + ## nested curved brackets + gprint ("..*syntax error: $charpair -- nested ((..))"); + ErrorMessage("$charpair -- syntax error: nested ((..)) not allowed"); + $errorflag="SET"; + }; + + # trap nested square brackets + if ( ($char2 eq "[" ) and ($squareflag eq "inside" ) ) { + ## nested square brackets + gprint ("..*syntax error: $charpair -- nested [[..]]"); + ErrorMessage("$charpair -- syntax error: nested [[..]] not allowed"); + $errorflag="SET"; + }; + + + if ($squareflag eq "inside"){ + if ($char1 eq ",") { + gprint ("..*syntax error: $charpair -- comma not allowed in [ ]"); + ErrorMessage("$charpair -- syntax error: comma not allowed in [ ]"); + $errorflag="SET"; + next; + }; + }; # end of if + + + ## detect end of string + if ($j == $lenstring -1) {last}; + + + }; # end of if + + }; # end of for + #--------------------------- + + + if ($errorflag eq "SET") { + + ## closing down + gprint ("..*Quiting Perl program -- syntax error"); + ErrorMessage ("QUITTING PERL PROGRAM -- syntax error"); + + print " closing down -- writing state........... OK\n"; + + quitprogram(); + + } + else{ + print " syntax OK; brackets balanced OK\n"; + print " done\n\n"; + }; + + +} ## end sub + + + +#==================== + +sub inverse { + +my $E = $_[0]; + + my $lastchar = substr ($E, -1,1); + my $frontchars = substr ($E, 0,-1); # correct + + if ($lastchar eq "2") {$newE = $E} + + elsif ($lastchar eq "p") { $newE = $frontchars} + + else { $newE = $E."p"}; + +return $newE; +} + +##====================== + |