first commit

perl/Examples/Chap1/check-move

@@ -0,0 +1,29 @@
+
+
+###
+### check_move
+###
+
+## Chapter 1 section 3
+
+@position = (' ', ('A') x 3); # Disks are all initially on peg A
+
+sub check_move {
+  my $i;
+  my ($disk, $start, $end) = @_;
+  if ($disk < 1 || $disk > $#position) {
+    die "Bad disk number $disk. Should be 1..$#position.\n";
+  }
+  unless ($position[$disk] eq $start) {
+    die "Tried to move disk $disk from $start, but it is on peg $position[$disk].\n";
+  }
+  for $i (1 .. $disk-1) {
+    if ($position[$i] eq $start) {
+      die "Can't move disk $disk from $start because $i is on top of it.\n";
+    } elsif ($position[$i] eq $end) {
+      die "Can't move disk $disk to $end because $i is already there.\n";
+    }
+  }
+  print "Moving disk $disk from $start to $end.\n";
+  $position[$disk] = $end;
+}