#!/usr/bin/env perl ## use Carp; use Fatal; use warnings; ## our $version = "v5.0 (25 February 2018)"; ## ## rubikrotation.pl ## VERSION 5.0 ## ## Copyright February 2018, ## RWD Nickalls (dick@nickalls.org) ## A Syropoulos (asyropoulos@yahoo.com) ## ## HISTORY ##------------------------------- ## v5.0 (25 February 2018) ##------------------------------- ## ## 4.2h (07 February 2018) ## --- adjusted the no of leading dots for the gprint command ## when writing the up, down,.. colour state to the log file ## so as to make the array form a square block (ie easier to read) ## (in MAIN) ## ## 4.2g ## --- 29 October 2017 added syntax checking for (( )) /inside/ squarebrackets ## (in SUB checksyntax) ## --- 24 October 2017 changed {};--> (), in SequenceNameNew (in SUB writestate) ## this repairs these chars back to their original state. ## --- 22 October 2017 minor adjustments to syntax checking (in SUB checksyntax) ## to allow some extra chars in the [name] and blocks. ## Ideally, we want to be able to use /any/ chars inside these infoblocks. ## ## 4.2f ## --- 05 Oct 2017 bugfix: added a ShowSequence [\space] bug fix in SUB checksyntax ## --- 04 Oct 2017 adjusted brackets < > error messages (lines 2643--2659) ## ## 4.2e: (29 Sept 2017) ## --- added a ``Western'' notation filter (provisional \& works) ## ## 4.2d: (10 August 2017) ## --- placed a checkstate() command inside the rotation keyword ## and stopped TEX writing the keyword checkstate to the rubikstate.dat file ## ## 4.2c: (2 August 2017) ## --- added new rubikkeyword "cubesize" to hold cube size (three or two) ## so we can tell which sort of cube is being processed ## We can use this to detect when using the TwoRotation command ## (for the TWOcube) vs when using the RubikRotation command ## (for the THREEcube); for eample with regard to random rotations ## (see random SUB; see RubikTwoCube.sty) ## ## 4.2b: (1 Aug 2017) ## --- Removed the random,0 option --> n=50 (random SUB) ## a zero or missing integer now generates an error message. ## ## 4.2a: (28 July 2017) ## --- bugfix: error if spaces in RubikRotation{random,n} string from LaTeX. ## Fixed to accommodate spaces, and uppercase random (lines 366 -- 388 approx) ## ##------------------------------- ## v4.0 (3 March 2017) ##------------------------------- ## changes in v3.6 (January 2017) ## --- included Jaap Rm and Rc notation ## --- new sub for improved expansion of mod-4 multiples of rotations (Oct 2016) ## --- restructured to facilitate processing arrays through the rotation sub ## --- included option for an block ## --- included Randelshofer superset ENG 3x3 notation ## --- implemented an `inverse' mode ## --- improved syntax checking ## --- used perltidy to polish the program layout ## (but only when making the pdf documentation-- see file rubikrotationPL.pdf) ## --- included a lot of new subroutines ##-------------------------------- ## changes in v3.2: ## v3.2h: (2 Oct 2016) ## improved the mod 4 routine using SUB rubikmod() ## improved comments to log file re: rotation processing ## ## 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 ## ## 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 ## ## v3.2c: added new commands: ## \RotationSequenceName{} ## \RotationSequenceClean{} ## ## v3.2a: added a \RubikSeqNEW{...} output line in the output file ## to facilitate typesetting the rotation sequence (works OK just now) ## ## v3.2: --- added leading ... to the comments written by the sub ## (the ... code indicates that comments are written by the Perl script) ## --- changed the word program, prog --> script ##-------------------------------- ## changes in v3.0: ## --- accepts command-line arguments for input (mandatory) and output (optional) filenames ## default output filename is: rubikOUT.txt ## --- included the symbols [ and ] to denote a rotation-name label (ie as well as *) ## --- fixed some of the variable definitions (as highlighted by pragma) ##-------------------------------- ## changes in v2.3: ## --- accepts a single commandline argument (datafilename) ## --- uses the standard modules Carp and Fatal (give extra line info on error) ##-------------------------------- ## changes in v2.2: ## --- changed licence --> LatexPP ## --- included random n errors in ERROR messages (lines 492--495) ## --- 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 (written by rubikrotation.sty), ## and calls subs to write the TeX_OUT_FILE, ## and finally closes all files. ## Each line of the input file (rubikstate.dat) is a comma separated list of arguments. ## The first argument in each line of the file rubikstate.dat is a rubikkeyword. ## ##--------------- ## 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 [-o ]\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; } else { SWITCHES: while($_ = $ARGV[0]) { shift; if (/^-h$/ || /^--help$/ ) { die $rubikversion,$usage, "\twhere,\n" . "\t[-h|--help]\tgives this help listing\n" . "\t[-v|--version]\tgives version\n" . "\t[-i] \tcreates specified input file\n", "\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){ croak $showargs, "\tNo input file specified!\n", $usage; } else { $source_file = $ARGV[0], shift; } } elsif (/^-o$/) { if (!@ARGV) { croak $showargs, "\tNo output file specified!\n", $usage; } else { $out_file = $ARGV[0], shift; } } elsif (/^-\w+/) { croak $showargs, "\t$_: Illegal command line switch!\n", $usage; } else { croak $showargs, "\tmissing filenames or ? missing -i or -o switch!\n", $usage; } } # end of while }; # end of else #================================ 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 ("...script = rubikrotation.pl $version"); ## 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 cube state (from File: $source_file)"); our $dataline = ""; our $newdataline =""; our $rubikkeyword = ""; our $cubesize = ""; ## to hold the size, as three (Rubik) or two (twocube) 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=""; our $jrcode = 0; ## We initialise a loop counter for use in the rotation sub ## (see line 624) #---------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 (){ next LINE if /^#/; #skip comments next LINE if /^%/; #skip comments 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 character ## clean leading and trailing 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= cubesize, up,down,left,right,front,back,checkstate,rotation: $rubikkeyword=$data[0]; ##-------------------------------- ## RWDN 2 August 2017 ## introduced keyword cubesize so prog can distinguish ## between a TWOcube and an THREEcube. ## Here we check for the rubikkeyword `cubesize' ## cubesize is currently only being used to change the array size in random SUB if ($rubikkeyword eq 'cubesize') { gprint ("..."); $rotationcommand=$dataline; ## used in output message gprint ("...command = $rotationcommand"); $cubesize = RemoveAllSpaces($data[1]); if ($cubesize eq "two") {gprint ("...cube = TWOcube")}; if ($cubesize eq "three") {gprint ("...cube = THREEcube")}; gprint ("..."); next LINE ; }; ## ------------------------------------ ## RWDN 7 February 2018 ## we vary the number of leading dots for the gprint command ## so as to make the array of colour codes (X,W,Y, etc) form ## a nice square when printed to the log file (the standard no is 3 dots) 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]; next LINE; }; 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]; 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]; 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]; 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]; 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]; 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(); 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') { ## this IF runs down to near end of MAIN ##RWDN 10 Aug 2017 ## moved checkstate to be inside rotation (so a next LINE will terminate prog) gprint ("..."); gprint ("...rotation keyword"); checkstate(); gprint ("..."); ## logfile marker for begining of `rotation/random' process # 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(); }; ##---------keyword = random----------------- ## (command used for scrambling the cube) ## if second argument in $dataline = random ## THEN we also need to check if third argument is an integer; ## if so send integer --> random sub. ##---------------------------- ## (28 July 2017: RWDN) : bugfix: ## better syntax checking required for the command ## as spaces before or after commas caused errors. ##----------------------------- ## allow upper and lowercase keyword random if ( lc( $data[1] ) =~ m/random/ ) { ## the string contains the keyword random ## now check for missing comma after the keyword if ( lc( RemoveAllSpaces($data[1]) ) ne "random" ) {## error, ? missing comma ErrorMessage("[$data[1]] --- missing comma after `random' "); next LINE; }; ## now check for the trailing integer if ( ( lc( RemoveAllSpaces($data[1]) ) eq "random") and ($data[2] eq "") ) { ## missing integer ErrorMessage("[$data[2]] --- missing integer after `random,'"); next LINE; }; if (RemoveAllSpaces($data[2]) =~ /\D/) { ## Note that the \D operator sees , 23, as a word not an integer. ## so if true then cannot be a number (D matches word and space elements) ErrorMessage("[$data[2]] --- this is not an integer"); next LINE; } else {## string consists of one or more integers ## check to see if more than one integer exists ## by seeing if the string changes if we remove all the spaces ## (note we have to use a string with the m operator) my $RAS = RemoveAllSpaces($data[2]); if ($data[2] =~ m/$RAS/ ) { ## OK so this must be a single integer ## so we can now do n random rotations ## by sending the integer to the random SUB random($data[2]); next LINE; } else {## there must be spaces separating several integers; ErrorMessage("[$data[2]] --- only one integer allowed"); next LINE; }; }; ## end of else } ## end of IF ##----------------------------------------------------------- else { ## -----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. #------------------------------- # infoblocks are strings bounded by angle brackets <..> # and are designed for holding metadata. # # Multiple comma separated infoblocks are allowed (but NOT nested). # All infoblocks are eventually concaternated into a colon separated string, and # returned into the OUT file (= rubikstateNEW.dat) as the macro \SequenceInfo. # # We process and then remove any infoblocks which exist. # infoblocks are chars delimited by <...> # # The SUB infoblockcolon replaces any commas with a colon (so as to # facilitate string manipulation, and allows us to distinguish between # a string and a data array), and returns a new string (= $newdataline). # # The RubikRotation argument allows for carrying special # keywords, eg which can be used to influence the process. # If several infoblocks exist, then we collect the contents into # variable SequenceInfo, and separate them with a colon; # # The SUB cutinfoblock returns TWO strings: # (1) the name of the new revised string = newdataline, (with infoblocks removed) # (2) the contents of the infoblock = $SequenceInfo infoblockcolon($dataline); ## rename the returned newdataline string to dataline ## and reinitialise the string newdataline so it can be used again. $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 to avoid errors # best to force lowercase so users can type the word as they want if ( lc($SequenceInfo) =~ m/(inverse)/) { ## set a FLAG $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); #--------repeat blocks-------------------------- ## there are now no more infoblocks, so we now look for repeat-blocks. ## these are embedded inside the rotation sequence ## we first reformulate any repeat blocks (,) --> {;} if they exist ## this is to allow us to process any repeat blocks as separate elements ## so we look for curved brackets ie indicating a repeat block, and ## if we find a ( we then send the dataline to the SUB fixrepeatelement() ## the SUB fixrepeatelement() then returns the new revised dataline string ## containing the FIRST repeat block which has been expanded. ## If there is another ( then we repeat the procedure until all ## repeat blocks have been expanded, and incorporated into the mail rotation 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 and semicolons ## ie (,) --> {;} etc $SequenceShortBrace=$dataline; ## 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 (= 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 from the string, # we can replace (repair to original state) any braces or or semicolons # around repeat strings (if exist) and then rename it as SequenceShort # which we will output at the end (in SUB writestate). if ( (index $SequenceShortBrace, '{') !=-1 ) { print " repairing braces and semicolon--> ()\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"; ## --------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 ( re: 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) ## plus any ErrorMessages ## -- all these are handled by the quitprogram sub quitprogram(); ##==============end of main========================== sub rotation { print " SUB rotation\n"; ## 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. ##--------------------------- ## variables used in SUBs rotation() and rubikmod() ## need to be defined outside the SUBs $modnumber=-1; #multiple associated with the char, eg D2 etc $rotcode=""; $rotnumber=0; #------------------ my @repeatcode = (); my $m=-1; my $originalrcode=""; my $j; ## used with m below my $numberofchars; ## length of a string my $nfrontchars; ##----------------- ## grab the rotation code passed to this sub from MAIN my $rcode = $_[0]; ## 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) ## 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 using in MAIN = line 226) ## for use in the rotation SUB. ## This counter is used to identify the first element (rcode) ## and used to grab [name] --> SequenceName. $jrcode=$jrcode+1; ## increment rotation element (char) counter ## -----check for [nameblocks]----------------------------- ## ## 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) ## If this is the case, then jump to next element in the array ## BUT if trailing comma is missing, then (error as next rotation will be included ## as part of the label) so need to trap this and ## make the test: is first AND last char a sq bracket? ## (strictly only need to look at /first/ char, as the early syntax check will have ## detected any unbalanced brackets already) 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 = nameblock 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. ##-------check for (repeatblocks)--------------------------------- ## ## we have already replaced any repeat chars (,) with {;} ## so we now check for elements with leading { and then expand them ## the appropriate number of times. ## Note that the actual expansion is done by SUB repeat() ## 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 ( $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) ##----------------------- ## RWDN Sept29 2017 testing to fix WESTERN notation problem ## arrange for user to be able to include in metadata etc ## -- as this will mean that one can store these algorithms as a macro if ( lc($SequenceInfo) =~ m/(western)/ ) { if ($rcode eq "l") {$rcode = "Lw"; gprint ("...WESTERN NOTATION: rotation l --> Lw, OK") }; if ($rcode eq "lp") {$rcode = "Lwp"; gprint ("...WESTERN NOTATION: rotation lp --> Lwp, OK") }; if ($rcode eq "r") {$rcode = "Rw"; gprint ("...WESTERN NOTATION: rotation r --> Rw, OK") }; if ($rcode eq "rp") {$rcode = "Rwp"; gprint ("...WESTERN NOTATION: rotation rp --> Rwp, OK") }; if ($rcode eq "f") {$rcode = "Fw"; gprint ("...WESTERN NOTATION: rotation f --> Fw, OK") }; if ($rcode eq "fp") {$rcode = "Fwp"; gprint ("...WESTERN NOTATION: rotation fp --> Fwp, OK") }; if ($rcode eq "b") {$rcode = "Bw"; gprint ("...WESTERN NOTATION: rotation b --> Bw, OK") }; if ($rcode eq "bp") {$rcode = "Bwp"; gprint ("...WESTERN NOTATION: rotation bp --> Bwp, OK") }; if ($rcode eq "u") {$rcode = "Uw"; gprint ("...WESTERN NOTATION: rotation u --> Uw, OK") }; if ($rcode eq "up") {$rcode = "Uwp"; gprint ("...WESTERN NOTATION: rotation up --> Uwp, OK") }; if ($rcode eq "d") {$rcode = "Dw"; gprint ("...WESTERN NOTATION: rotation d --> Dw, OK") }; if ($rcode eq "dp") {$rcode = "Dwp"; gprint ("...WESTERN NOTATION: rotation dp --> Dwp, OK") }; }; ##----------------------- 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 ($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 ($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}} #### 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}} #### 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" or $rcode eq "lp") {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" or $rcode eq "rp") {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" or $rcode eq "dp") {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" or $rcode eq "up") {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" or $rcode eq "bp") {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" or $rcode eq "fp") {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 { ## 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"); ## DO NOT --> (next LINE;) here as need to check /all/ the rotation codes in the string. } else{ gprint ("..*rotation $rcode ERROR -- code not known ? typo or missing comma"); ErrorMessage("$originalrcode -- code not known ? typo or missing comma"); ## DO NOT --> (next LINE;) here as need to check /all/ the rotation codes in the string. }; #----------------------------- next; }; #end of else next; } # end of sub #====================================== 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 ## ## 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 slice (Xm) ones as well. ## initialise the array for the random rotations my @rrlist = (); ## (RWDN 2 Aug 2017): ## now check to see if TWOcube or Rubikcube being used ## use cubesize as the filter if ($cubesize eq 'two') { ## using the TwoRotation command (from RubikTwoCube.sty) ## no slice rotations ## @rrlist = ("U", "Up", "D", "Dp", "L", "Lp", "R", "Rp", "F", "Fp", "B", "Bp"); } else { ## using the RubikRotation command (from RubikRotation.sty) @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"; gprint ("...random SUB: rrlistnumber (array size) = $rrlistnumber"); # these are numbered 0--$rrlistnumber, ## let default no of random rotations for scrambling = 50 my $defaultn = 50; ## RWDN (1 Aug 2017): not being used any more 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 ("..*ERR: integer n = 0 (invalid)"); ErrorMessage (" --- integer n = 0 (invalid)"); next LINE; }; my @rr; ## array to hold all the random rotations print " randomising the available rotations\n"; ## set the seed for the randomisation (Perl 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, ## then max rand vaue = (lastindexnumber -1).99999, the integer of which ## = (lastindexnumber -1). Therefore we need to use the range 0--(lastindexnumber+1) ## in order to randomise all posibilities on our list. my $j; for ($j = 1; $j <=$s; $j=$j+1) { my $p= int(rand ($rrlistnumber +1)); print "Rotation = $p, $rrlist[$p] \n"; ## push rotation code $rrlist[$p] on to END of array @rr push (@rr, $rrlist[$p]); }; ## we assume the user is starting from a solved cube (ie use the state given by user) gprint ("...scrambling cube using $s random rotations"); ## now send the array off to the rotation sub my $E; foreach $E (@rr) { rotation($E) }; } ##end of sub #====================================== sub writestate { print " SUB writestate\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 cube 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"); print (TeX_OUT_FILE "\\RubikFaceLeft\{$Llt[0]\}\{$Lmt[0]\}\{$Lrt[0]\}\{$Llm[0]\}\{$Lmm[0]\}\{$Lrm[0]\}\{$Llb[0]\}\{$Lmb[0]\}\{$Lrb[0]\}\%\n"); print (TeX_OUT_FILE "\\RubikFaceRight\{$Rlt[0]\}\{$Rmt[0]\}\{$Rrt[0]\}\{$Rlm[0]\}\{$Rmm[0]\}\{$Rrm[0]\}\{$Rlb[0]\}\{$Rmb[0]\}\{$Rrb[0]\}\%\n"); 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); }; ## RWDN 24 October 2017 ## swap char changes back before writing output string ## only swap the brackets ## (do NOT swap ; --> , as ONLY use commas /outside/ infoblocks and between rotation sequences) ## swap: BBook p 138--139 $SequenceNameNew =~ tr/\{/(/; # swap { --> ( $SequenceNameNew =~ tr/\}/)/; # swap } --> ) 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 (as used by Kociemba), ## so we have to change { } --> [ ] since otherwise they will disappear ## or cause an 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"); ##----------------------- ##-----------SequenceLong------------------- ## 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") { ## 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 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) { ## 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 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)"); # next LINE }; 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 ## of the cubie facelets. ## The following 9 subroutines are named as follows: ## (about X-axis) rrR, rrSr, rrLp ## (about Y-axis) rrU, rrSu, rrDp ## (about Z-axis) rrF, rrSf, rrBp ## see the rubikcube package documentation for full details regarding ## rotation notation and commands. ## METHOD & NOTATION ## each sub (below) starts by making an array[0] for the cubie colour ## and an array[1] for the cubie number. ## Each of the face rotations (rrR, rrLp, rrU, rrDp, rrF, rrBp) is involved with ## 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 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 { ## 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 ## the new position of Up-right-bottom (Urb) (side)facelet. ##-----------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], $Drb[0],$Drm[0],$Drt[0]); @Rs1=($Frb[1],$Frm[1],$Frt[1], $Urb[1],$Urm[1],$Urt[1], $Blt[1],$Blm[1],$Blb[1], $Drb[1],$Drm[1],$Drt[1]); ## now we reallocate the initial array elements to the new ## post (90 degree clockwise) rotation position. ## Cube is viewed from FRONT. ## Positions of side facelets of Right slice are numbered 0-11 in clockwise direction, ## (as seen from Right face) starting with Up-right-bottom facelet. ## 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]; $Blt[0]=$Rs0[3]; $Blt[1]=$Rs1[3]; $Blm[0]=$Rs0[4]; $Blm[1]=$Rs1[4]; $Blb[0]=$Rs0[5]; $Blb[1]=$Rs1[5]; $Drb[0]=$Rs0[6]; $Drb[1]=$Rs1[6]; $Drm[0]=$Rs0[7]; $Drm[1]=$Rs1[7]; $Drt[0]=$Rs0[8]; $Drt[1]=$Rs1[8]; $Frb[0]=$Rs0[9]; $Frb[1]=$Rs1[9]; $Frm[0]=$Rs0[10]; $Frm[1]=$Rs1[10]; $Frt[0]=$Rs0[11]; $Frt[1]=$Rs1[11]; ##-------------Right FACE--------------------- ## 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]); ## now we reallocate the array elements to the new ## post (90 degree clockwise) rotation facelet position. ## Right face is viewed from RIGHT. ## 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]; $Rlm[0]=$Rf0[3]; $Rlm[1]=$Rf1[3]; $Rmm[0]=$Rf0[4]; $Rmm[1]=$Rf1[4]; $Rrm[0]=$Rf0[5]; $Rrm[1]=$Rf1[5]; $Rlb[0]=$Rf0[6]; $Rlb[1]=$Rf1[6]; $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) ## 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 ## make the post rotation permutation @SRs0=($Fmb[0],$Fmm[0],$Fmt[0], $Umb[0],$Umm[0],$Umt[0], $Bmt[0],$Bmm[0],$Bmb[0], $Dmb[0],$Dmm[0],$Dmt[0]); @SRs1=($Fmb[1],$Fmm[1],$Fmt[1], $Umb[1],$Umm[1],$Umt[1], $Bmt[1],$Bmm[1],$Bmb[1], $Dmb[1],$Dmm[1],$Dmt[1]); $Umb[0]=$SRs0[0]; $Umb[1]=$SRs1[0]; $Umm[0]=$SRs0[1]; $Umm[1]=$SRs1[1]; $Umt[0]=$SRs0[2]; $Umt[1]=$SRs1[2]; $Bmt[0]=$SRs0[3]; $Bmt[1]=$SRs1[3]; $Bmm[0]=$SRs0[4]; $Bmm[1]=$SRs1[4]; $Bmb[0]=$SRs0[5]; $Bmb[1]=$SRs1[5]; $Dmb[0]=$SRs0[6]; $Dmb[1]=$SRs1[6]; $Dmm[0]=$SRs0[7]; $Dmm[1]=$SRs1[7]; $Dmt[0]=$SRs0[8]; $Dmt[1]=$SRs1[8]; $Fmb[0]=$SRs0[9]; $Fmb[1]=$SRs1[9]; $Fmm[0]=$SRs0[10]; $Fmm[1]=$SRs1[10]; $Fmt[0]=$SRs0[11]; $Fmt[1]=$SRs1[11]; } #====================================== 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], $Dlb[0],$Dlm[0],$Dlt[0]); @LPs1=($Flb[1],$Flm[1],$Flt[1], $Ulb[1],$Ulm[1],$Ult[1], $Brt[1],$Brm[1],$Brb[1], $Dlb[1],$Dlm[1],$Dlt[1]); $Ulb[0]=$LPs0[0]; $Ulb[1]=$LPs1[0]; $Ulm[0]=$LPs0[1]; $Ulm[1]=$LPs1[1]; $Ult[0]=$LPs0[2]; $Ult[1]=$LPs1[2]; $Brt[0]=$LPs0[3]; $Brt[1]=$LPs1[3]; $Brm[0]=$LPs0[4]; $Brm[1]=$LPs1[4]; $Brb[0]=$LPs0[5]; $Brb[1]=$LPs1[5]; $Dlb[0]=$LPs0[6]; $Dlb[1]=$LPs1[6]; $Dlm[0]=$LPs0[7]; $Dlm[1]=$LPs1[7]; $Dlt[0]=$LPs0[8]; $Dlt[1]=$LPs1[8]; $Flb[0]=$LPs0[9]; $Flb[1]=$LPs1[9]; $Flm[0]=$LPs0[10]; $Flm[1]=$LPs1[10]; $Flt[0]=$LPs0[11]; $Flt[1]=$LPs1[11]; ##---------------Left FACE------------- ## 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 @LPf0=($Lrt[0], $Lrm[0], $Lrb[0], $Lmt[0], $Lmm[0], $Lmb[0], $Llt[0], $Llm[0], $Llb[0]); @LPf1=($Lrt[1], $Lrm[1], $Lrb[1], $Lmt[1], $Lmm[1], $Lmb[1], $Llt[1], $Llm[1], $Llb[1]); $Llt[0]=$LPf0[0]; $Llt[1]=$LPf1[0]; $Lmt[0]=$LPf0[1]; $Lmt[1]=$LPf1[1]; $Lrt[0]=$LPf0[2]; $Lrt[1]=$LPf1[2]; $Llm[0]=$LPf0[3]; $Llm[1]=$LPf1[3]; $Lmm[0]=$LPf0[4]; $Lmm[1]=$LPf1[4]; $Lrm[0]=$LPf0[5]; $Lrm[1]=$LPf1[5]; $Llb[0]=$LPf0[6]; $Llb[1]=$LPf1[6]; $Lmb[0]=$LPf0[7]; $Lmb[1]=$LPf1[7]; $Lrb[0]=$LPf0[8]; $Lrb[1]=$LPf1[8]; } #====================================== 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], $Frt[0],$Fmt[0],$Flt[0]); @Us1=($Lrt[1],$Lmt[1],$Llt[1], $Brt[1],$Bmt[1],$Blt[1], $Rrt[1],$Rmt[1],$Rlt[1], $Frt[1],$Fmt[1],$Flt[1]); $Brt[0]=$Us0[0]; $Brt[1]=$Us1[0]; $Bmt[0]=$Us0[1]; $Bmt[1]=$Us1[1]; $Blt[0]=$Us0[2]; $Blt[1]=$Us1[2]; $Rrt[0]=$Us0[3]; $Rrt[1]=$Us1[3]; $Rmt[0]=$Us0[4]; $Rmt[1]=$Us1[4]; $Rlt[0]=$Us0[5]; $Rlt[1]=$Us1[5]; $Frt[0]=$Us0[6]; $Frt[1]=$Us1[6]; $Fmt[0]=$Us0[7]; $Fmt[1]=$Us1[7]; $Flt[0]=$Us0[8]; $Flt[1]=$Us1[8]; $Lrt[0]=$Us0[9]; $Lrt[1]=$Us1[9]; $Lmt[0]=$Us0[10]; $Lmt[1]=$Us1[10]; $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]); $Ult[0]=$Uf0[0]; $Ult[1]=$Uf1[0]; $Umt[0]=$Uf0[1]; $Umt[1]=$Uf1[1]; $Urt[0]=$Uf0[2]; $Urt[1]=$Uf1[2]; $Ulm[0]=$Uf0[3]; $Ulm[1]=$Uf1[3]; $Umm[0]=$Uf0[4]; $Umm[1]=$Uf1[4]; $Urm[0]=$Uf0[5]; $Urm[1]=$Uf1[5]; $Ulb[0]=$Uf0[6]; $Ulb[1]=$Uf1[6]; $Umb[0]=$Uf0[7]; $Umb[1]=$Uf1[7]; $Urb[0]=$Uf0[8]; $Urb[1]=$Uf1[8]; } #====================================== 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], $Frm[0],$Fmm[0],$Flm[0]); @SUs1=($Lrm[1],$Lmm[1],$Llm[1], $Brm[1],$Bmm[1],$Blm[1], $Rrm[1],$Rmm[1],$Rlm[1], $Frm[1],$Fmm[1],$Flm[1]); $Brm[0]=$SUs0[0]; $Brm[1]=$SUs1[0]; $Bmm[0]=$SUs0[1]; $Bmm[1]=$SUs1[1]; $Blm[0]=$SUs0[2]; $Blm[1]=$SUs1[2]; $Rrm[0]=$SUs0[3]; $Rrm[1]=$SUs1[3]; $Rmm[0]=$SUs0[4]; $Rmm[1]=$SUs1[4]; $Rlm[0]=$SUs0[5]; $Rlm[1]=$SUs1[5]; $Frm[0]=$SUs0[6]; $Frm[1]=$SUs1[6]; $Fmm[0]=$SUs0[7]; $Fmm[1]=$SUs1[7]; $Flm[0]=$SUs0[8]; $Flm[1]=$SUs1[8]; $Lrm[0]=$SUs0[9]; $Lrm[1]=$SUs1[9]; $Lmm[0]=$SUs0[10]; $Lmm[1]=$SUs1[10]; $Llm[0]=$SUs0[11]; $Llm[1]=$SUs1[11]; } #====================================== sub rrDp { ## 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], $Frb[0],$Fmb[0],$Flb[0]); @DPs1=($Lrb[1],$Lmb[1],$Llb[1], $Brb[1],$Bmb[1],$Blb[1], $Rrb[1],$Rmb[1],$Rlb[1], $Frb[1],$Fmb[1],$Flb[1]); $Brb[0]=$DPs0[0]; $Brb[1]=$DPs1[0]; $Bmb[0]=$DPs0[1]; $Bmb[1]=$DPs1[1]; $Blb[0]=$DPs0[2]; $Blb[1]=$DPs1[2]; $Rrb[0]=$DPs0[3]; $Rrb[1]=$DPs1[3]; $Rmb[0]=$DPs0[4]; $Rmb[1]=$DPs1[4]; $Rlb[0]=$DPs0[5]; $Rlb[1]=$DPs1[5]; $Frb[0]=$DPs0[6]; $Frb[1]=$DPs1[6]; $Fmb[0]=$DPs0[7]; $Fmb[1]=$DPs1[7]; $Flb[0]=$DPs0[8]; $Flb[1]=$DPs1[8]; $Lrb[0]=$DPs0[9]; $Lrb[1]=$DPs1[9]; $Lmb[0]=$DPs0[10]; $Lmb[1]=$DPs1[10]; $Llb[0]=$DPs0[11]; $Llb[1]=$DPs1[11]; ##---------------Down FACE------------------- ## f = face; 0=colour, 1= number @DPf0=($Dlt[0], $Dlm[0], $Dlb[0], $Dmt[0], $Dmm[0], $Dmb[0], $Drt[0], $Drm[0], $Drb[0]); @DPf1=($Dlt[1], $Dlm[1], $Dlb[1], $Dmt[1], $Dmm[1], $Dmb[1], $Drt[1], $Drm[1], $Drb[1]); $Dlb[0]=$DPf0[0]; $Dlb[1]=$DPf1[0]; $Dmb[0]=$DPf0[1]; $Dmb[1]=$DPf1[1]; $Drb[0]=$DPf0[2]; $Drb[1]=$DPf1[2]; $Dlm[0]=$DPf0[3]; $Dlm[1]=$DPf1[3]; $Dmm[0]=$DPf0[4]; $Dmm[1]=$DPf1[4]; $Drm[0]=$DPf0[5]; $Drm[1]=$DPf1[5]; $Dlt[0]=$DPf0[6]; $Dlt[1]=$DPf1[6]; $Dmt[0]=$DPf0[7]; $Dmt[1]=$DPf1[7]; $Drt[0]=$DPf0[8]; $Drt[1]=$DPf1[8]; } #====================================== 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], $Drt[0],$Dmt[0],$Dlt[0]); @Fs1=($Lrb[1],$Lrm[1],$Lrt[1], $Ulb[1],$Umb[1],$Urb[1], $Rlt[1],$Rlm[1],$Rlb[1], $Drt[1],$Dmt[1],$Dlt[1]); $Ulb[0]=$Fs0[0]; $Ulb[1]=$Fs1[0]; $Umb[0]=$Fs0[1]; $Umb[1]=$Fs1[1]; $Urb[0]=$Fs0[2]; $Urb[1]=$Fs1[2]; $Rlt[0]=$Fs0[3]; $Rlt[1]=$Fs1[3]; $Rlm[0]=$Fs0[4]; $Rlm[1]=$Fs1[4]; $Rlb[0]=$Fs0[5]; $Rlb[1]=$Fs1[5]; $Drt[0]=$Fs0[6]; $Drt[1]=$Fs1[6]; $Dmt[0]=$Fs0[7]; $Dmt[1]=$Fs1[7]; $Dlt[0]=$Fs0[8]; $Dlt[1]=$Fs1[8]; $Lrb[0]=$Fs0[9]; $Lrb[1]=$Fs1[9]; $Lrm[0]=$Fs0[10]; $Lrm[1]=$Fs1[10]; $Lrt[0]=$Fs0[11]; $Lrt[1]=$Fs1[11]; ## -------Front FACE------------------- ## f = face; 0=colour, 1= number @Lf0=($Flb[0], $Flm[0], $Flt[0], $Fmb[0], $Fmm[0], $Fmt[0], $Frb[0], $Frm[0], $Frt[0]); @Lf1=($Flb[1], $Flm[1], $Flt[1], $Fmb[1], $Fmm[1], $Fmt[1], $Frb[1], $Frm[1], $Frt[1]); $Flt[0]=$Lf0[0]; $Flt[1]=$Lf1[0]; $Fmt[0]=$Lf0[1]; $Fmt[1]=$Lf1[1]; $Frt[0]=$Lf0[2]; $Frt[1]=$Lf1[2]; $Flm[0]=$Lf0[3]; $Flm[1]=$Lf1[3]; $Fmm[0]=$Lf0[4]; $Fmm[1]=$Lf1[4]; $Frm[0]=$Lf0[5]; $Frm[1]=$Lf1[5]; $Flb[0]=$Lf0[6]; $Flb[1]=$Lf1[6]; $Fmb[0]=$Lf0[7]; $Fmb[1]=$Lf1[7]; $Frb[0]=$Lf0[8]; $Frb[1]=$Lf1[8]; } #====================================== 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], $Drm[0],$Dmm[0],$Dlm[0]); @SFs1=($Lmb[1],$Lmm[1],$Lmt[1], $Ulm[1],$Umm[1],$Urm[1], $Rmt[1],$Rmm[1],$Rmb[1], $Drm[1],$Dmm[1],$Dlm[1]); $Ulm[0]=$SFs0[0]; $Ulm[1]=$SFs1[0]; $Umm[0]=$SFs0[1]; $Umm[1]=$SFs1[1]; $Urm[0]=$SFs0[2]; $Urm[1]=$SFs1[2]; $Rmt[0]=$SFs0[3]; $Rmt[1]=$SFs1[3]; $Rmm[0]=$SFs0[4]; $Rmm[1]=$SFs1[4]; $Rmb[0]=$SFs0[5]; $Rmb[1]=$SFs1[5]; $Drm[0]=$SFs0[6]; $Drm[1]=$SFs1[6]; $Dmm[0]=$SFs0[7]; $Dmm[1]=$SFs1[7]; $Dlm[0]=$SFs0[8]; $Dlm[1]=$SFs1[8]; $Lmb[0]=$SFs0[9]; $Lmb[1]=$SFs1[9]; $Lmm[0]=$SFs0[10]; $Lmm[1]=$SFs1[10]; $Lmt[0]=$SFs0[11]; $Lmt[1]=$SFs1[11]; } #====================================== 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], $Drb[0],$Dmb[0],$Dlb[0]); @BPs1=($Llb[1],$Llm[1],$Llt[1], $Ult[1],$Umt[1],$Urt[1], $Rrt[1],$Rrm[1],$Rrb[1], $Drb[1],$Dmb[1],$Dlb[1]); $Ult[0]=$BPs0[0]; $Ult[1]=$BPs1[0]; $Umt[0]=$BPs0[1]; $Umt[1]=$BPs1[1]; $Urt[0]=$BPs0[2]; $Urt[1]=$BPs1[2]; $Rrt[0]=$BPs0[3]; $Rrt[1]=$BPs1[3]; $Rrm[0]=$BPs0[4]; $Rrm[1]=$BPs1[4]; $Rrb[0]=$BPs0[5]; $Rrb[1]=$BPs1[5]; $Drb[0]=$BPs0[6]; $Drb[1]=$BPs1[6]; $Dmb[0]=$BPs0[7]; $Dmb[1]=$BPs1[7]; $Dlb[0]=$BPs0[8]; $Dlb[1]=$BPs1[8]; $Llb[0]=$BPs0[9]; $Llb[1]=$BPs1[9]; $Llm[0]=$BPs0[10]; $Llm[1]=$BPs1[10]; $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]); $Brt[0]=$BPf0[0]; $Brt[1]=$BPf1[0]; $Bmt[0]=$BPf0[1]; $Bmt[1]=$BPf1[1]; $Blt[0]=$BPf0[2]; $Blt[1]=$BPf1[2]; $Brm[0]=$BPf0[3]; $Brm[1]=$BPf1[3]; $Bmm[0]=$BPf0[4]; $Bmm[1]=$BPf1[4]; $Blm[0]=$BPf0[5]; $Blm[1]=$BPf1[5]; $Brb[0]=$BPf0[6]; $Brb[1]=$BPf1[6]; $Bmb[0]=$BPf0[7]; $Bmb[1]=$BPf1[7]; $Blb[0]=$BPf0[8]; $Blb[1]=$BPf1[8]; } #====================================== #====================================== ## 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 # from Black Book page 147 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 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 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 { print " SUB repeat\n"; ## this SUB expand the repeating elements ## this SUB receives a repeat string in the form {L,R, }3 ## The original () were converted (above) into {} so we can distinguish the brackets. ## we than extract the code sequence and the terminal repeat number ## Then we join n copies of the code string to form a long cs string. ## then we insert this new long string into the main rotation sequence without the {} ## Ultimately the fully expanded rotation sequence is fed into SUB rotation for processing. ## grab 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"; ##----------------------- ## now get the repeat number 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 ##------------------- ## now make n copies of repeatcode and name the string = $insert ## (which is then used by another part of the prog) ## 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 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 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 # from Black book page 143 my $string=$_[0]; $string =~ s/\s//g; # OK return $string; } #====================================== sub CheckSyntax { ## this check is used at an early stage in the program, so we can terminate early ## if necessary. We check that all () {} <> are matched (if any exist), ## missing commas, illegal combinations of chars etc. ## if any serious errors (eg brackets not balanced), then we SET an errorflag, ## and terminate the program. print " SUB CheckSyntax\n"; my $dataline = $_[0]; ## first clean out all spaces in a string ## so we can then look for specific combinations of characters $dataline=RemoveAllSpaces($dataline); print " dataline = $dataline\n"; ##------------------------------------- ## first we check for unbalanced brackets ## 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//>/); $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"; my $errorflag = ""; if ($leftsum != $rightsum) { if ( $nleftS != $nrightS ) ## Square brackets { gprint ("..*brackets ERROR [ ] Left [$nleftS not equal to Right ]$nrightS"); ErrorMessage ("brackets [ ]: Left [$nleftS not equal to Right ]$nrightS"); $errorflag="SET"; } if ( $nleftC != $nrightC ) ## Curved brackets { gprint ("..*brackets ERROR ( ) Left ($nleftC not equal to Right )$nrightC"); ErrorMessage ("brackets ( ): Left ($nleftC not equal to Right )$nrightC"); $errorflag="SET"; } if ( $nleftA != $nrightA ) ## Angle brackets { 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, eg illegal pairings of characters ## BlackBook p136 my ($char1, $char2, $charpair) = ""; my ($j, $lenstring) = 0; $lenstring= length $dataline; print " lenstring = $lenstring\n"; ## we set up a system which allows us to know whether or not we are ## inside a set of brackets. To do this we increment / decrement counters ## each time we pass through a bracket. ## If sum NOT equal to zero, then we are inside etc. ## first initialise each left and right variable. ## seems important that these initialisations are done separately. my $angleNumLeft = 0; my $angleNumRight = 0; my $angleNumSum = 0; my $squareNumLeft = 0; my $squareNumRight = 0; my $squareNumSum = 0; my $curvedNumLeft = 0; my $curvedNumRight = 0; my $curvedNumSum = 0; ## look at each char, and each pair of chars ## with brackets, we increment (right) and decrement (left) the count ## so we can tell if we are inside or outside a set of nested brackets. ## (we need to detect errors in the rotation sequence itself ## and also inside squarebrackets] since these can occur anywhere, ## but not in the angle infoblocks <..> where we want to be able to write anything) 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 '<'){ $angleNumLeft = $angleNumLeft+1}; if ($char1 eq '>'){$angleNumRight = $angleNumRight-1}; if ($char1 eq '['){$squareNumLeft = $squareNumLeft+1}; if ($char1 eq ']'){$squareNumRight = $squareNumRight-1}; if ($char1 eq '('){$curvedNumLeft = $curvedNumLeft+1}; if ($char1 eq ')'){$curvedNumRight = $curvedNumRight-1}; $angleNumSum = $angleNumLeft + $angleNumRight; $squareNumSum = $squareNumLeft + $squareNumRight; $curvedNumSum = $curvedNumLeft + $curvedNumRight; ##RWDN 22 Oct 2017 ##------------ ## need to trap nested (( )) inside squarebrackets if ($squareNumSum != 0) { if ( $charpair =~ m/(\(\(|\)\))/ ) { # nested curved brackets inside sq brackets gprint ("..*syntax error: $charpair -- nested ((..)) in [ ]"); ErrorMessage("$charpair -- syntax error: nested ((..)) not allowed in [ ]"); $errorflag="SET"; }; }; ##-------------- ## if outside angle brackets AND outside square brackets ## then we are checking ONLY the rotation sequence codes if ( ($angleNumSum == 0) and ($squareNumSum == 0) ) { ## 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 (= inside) if ( ($char2 eq "(" ) and ($curvedNumSum != 0) ) { ## nested curved brackets gprint ("..*syntax error: $charpair -- nested ((..))"); ErrorMessage("$charpair -- syntax error: nested ((..)) not allowed"); $errorflag="SET"; }; #-----remove-------------------------------------- # trap comma inside [ ] ( eq inside) # if ($squareNumSum != 0){ # 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"); ##------bug fix----------------------- ## RWDN 5 October 2017 ## problem = since we are here checking syntax (ie before processing any ## output SequenceXX strings) all four SequenceXX strings will be empty just now. ## This then causes an error if the Rubik user code includes a ShowSequence command, ## since the ForEachX macro used by ShowSequence macro cannot handle an empty string ## when dealing with SequenceShort and SequenceLong. ## So we heve to force these two strings to be just a [\space] before they are output ## by the SUB writestate. ## ie we set SequenceShort and SequenceLong strings to \space here before ## CALLing the SUB quitprogram(). ## (to avoid a Rubikcube ShowSequence{}{}{} error if argument is empty ## or is an expandable macro) ## This problem arises because the ShowSequence macro uses the ForEachX macro ## to process each cs element in a string. ## Also need to add at least one empty char or comma at end of SequenceLong string, ## as final char (comma) is removed when writing to the out file in SUB writestate ## (CALLed by SUB quitprogram) just prior to closing down. ## NB: if there is no extra terminal char for SequenceLong string, ## then \space --> \spac --> TEX error message ## ## This issue does not seem to be a problem for SequenceInfo and SequenceName, ## as they are not returned as cs strings. $SequenceShort="\\space"; $SequenceLong= "\\space,"; ##--------------------------- 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; } ##====================== ##EOF