#!/usr/bin/perl  -w

use strict;

# sub decls for driver
sub interact();
sub longprompt();
sub prompt();
sub getnum($$);

# sub decls for list manips
sub append($$);
sub remove($);
sub find($$);
sub count($$);
sub copy($$);

# main program
interact();
exit;

#############################
## driver functions
#############################

sub interact() {
    my ($head, $tail);

    print "I have initialized an empty linked list of real numbers.\n";

    for (prompt(); <STDIN>; prompt()) {
	my($cmd, $arg) = split;
	next unless $cmd;
	$cmd = uc($cmd);

	if     ($cmd eq 'C') {
	    getnum($arg, "Type number to count");
	    print "List has ",  count($head, $arg), " occurrences of $arg\n";
	} 
	elsif ($cmd eq 'A') {
	    getnum($arg, "Type a legal number to insert");
	    $tail = append($tail || $head, $arg);
	}
	elsif ($cmd eq 'R') {
	    print "Removing $tail->{VALUE}\n" if $tail;
	    $tail = remove($head);
	}
	elsif ($cmd eq 'S') {
	    getnum($arg, "Type amount to copy");
	    my $copy = copy($head, $arg);
	    print "Here is the result of the copy of that segment: ";
	    for (my $node = $copy;  $node; $node = $node->{LINK}) {
		print $node->{VALUE}, " ";
	    }
	    print "\n";
	}
	elsif ($cmd =~ /^[LP]/) {
	    print "List: ";
	    for (my $node = $head;  $node; $node = $node->{LINK}) {
		print $node->{VALUE}, " ";
	    }
	    print "\n";
	}
	elsif ($cmd eq 'Q') {
	    print "Done.\n";
	    exit;
	} else {
	    longprompt();
	} 
    } 
} 


sub longprompt() {
    print <<EOF;

     C   Count the number of occurrences of some number
     A   Attach a new number at the tail
     R   Remove a number from the tail
     S   Copy the front of the list, and print this segment

     P   Print the current list
     Q   Quit this test program


EOF
} 

sub prompt() {
    print "The following choices are available: C A R S P Q\n";
    print "Enter choice: ";
} 

sub getnum($$) {		# may reset caller 
    my($arg, $prompt) = @_;
    while ( $arg !~ /^\s*[+-]?\d+\.?\d*\s*$/ ) {
	print "$prompt: ";
	$arg = <STDIN>;
	exit unless defined $arg;
	chomp $arg;
    } 
    $_[0] = $arg;	# reset caller
} 

#############################
## list functions
#############################

sub append($$) {		## returns node, may reset caller
    my($list, $value) = @_;
    getnum($value, "Enter a legal value");
    my $node = { VALUE => $value };		# allocate new node
    if ($list) { 
	$node->{LINK} = $list->{LINK};
	$list->{LINK} = $node;
    } else {
	$_[0] = $node;				# change caller's ref
    } 

    return $node;
} 

sub find($$) {			## returns found node, or undef
    my($list, $value) = @_;

    for (;$list; $list = $list->{LINK}) {
	return $list if $list->{VALUE} == $value;
    } 
    return;
} 

sub count($$) {			## returns occurrences
    my($list, $value) = @_;

    my $count = 0;
    for (; $list; $list = $list->{LINK}) {
	$count += $list->{VALUE} == $value;
    } 
    return $count;
} 

sub remove($) {		      ## returns new tail, may reset caller
    my($cur) = @_;
    return unless $cur;

    unless ($cur->{LINK}) {   # just one node
	undef $_[0];	      # change caller
	return;
    } 

    my ($prev);
    for (; $cur && $cur->{LINK}; $cur = $cur->{LINK}) {
	$prev = $cur;
    }
    delete $prev->{LINK};
    return $prev;

} 

sub copy($$) { 			## return new list
    my ($oldhead, $count) = @_;
    my ($newhead, $newtail);
    return unless $oldhead;
    $newtail = append($newhead, $oldhead->{VALUE});
    $oldhead = $oldhead->{LINK};
    while (--$count > 0 && $oldhead) {
	$newtail = append($newtail, $oldhead->{VALUE});
	$oldhead = $oldhead->{LINK};
    } 
    return $newhead;
}