---

Jeg har lavet et simpel script. Det tog mig lang tid at finde ud af lave
det, for jeg vidste ikke hvordan jeg ku' realisere det, og jeg har ikke ret
meget forstand på at programmere i PERL. Det kan I hurtig se når I kigger på
mit script. Scriptet virker som jeg forventede, men det skal vist
optimeres en lille smule, for scripet virker fint, men hvis man kalder det i
et andet script så får jeg " not enough memory" og dermed et blank skærm.
Kan mit lille script bruge så meget hukommelse egentlig? Jeg har ikke
kendskab til moduler og jeg vil helst undgå at bruge dem, for jeg ved ikke
hvilke moduler jeg har adgang (jeg bruger et eller andet webhotel hallojså).
Her er mit script:

#!/usr/local/bin/perl

$teksten = 'Bare en test';
$farve1 = 'ff0000';
$farve2 = '0000ff';

&fade($farve1, $farve2, $teksten);

sub fade{
local($color1,$color2,$tekst) = @_;

&make_array($tekst);
#################### color 1 ##############################
$red1 = hex(substr($color1,0,2));
$green1 = hex(substr($color1,2,2));
$blue1 = hex(substr($color1,4,2));
#################### color 2 ##############################
$red2 = hex(substr($color2,0,2));
$green2 = hex(substr($color2,2,2));
$blue2 = hex(substr($color2,4,2));

@red_array = &color_array($red1,$red2);
@green_array = &color_array($green1,$green2);
@blue_array = &color_array($blue1,$blue2);

$count = 0;
while ($count <= $laengde){
$final_array[$count] =
$red_array[$count].$green_array[$count].$blue_array[$count];
$count++;
}

$final_count = 0;
@fade_msg= "<b>";
while ($final_count <= $#final_array){
if ($ord[$final_count] eq " "){
push (@fade_msg, " ");
}else{
push (@fade_msg,"<font
color=\"$final_array[$final_count]\">$ord[$final_count]</font>");
}
$final_count++;
}
push(@fade_msg,"</b>");
#return @fade_msg;
}


####################### decimal to hex convertion #######################
sub dec_to_hex{
my($tal) = $_[0];
if ($tal < 10){
$result = "0$tal";
}elsif($tal > 10 && $tal <15){
if ($tal == 10){$tal = 'a';}
elsif ($tal == 11){$tal = 'b';}
elsif ($tal == 12){$tal = 'c';}
elsif ($tal == 13){$tal = 'd';}
elsif ($tal == 14){$tal = 'e';}
elsif ($tal == 15){$tal = 'f';}
$result = $tal;

}else{
$tal1 = int($tal/16);
if ($tal1 == 10){$tal1 = 'a';}
elsif ($tal1 == 11){$tal1 = 'b';}
elsif ($tal1 == 12){$tal1 = 'c';}
elsif ($tal1 == 13){$tal1 = 'd';}
elsif ($tal1 == 14){$tal1 = 'e';}
elsif ($tal1 == 15){$tal1 = 'f';}

$tal2 = $tal % 16;
if ($tal2 == 10){$tal2 = 'a';}
elsif ($tal2 == 11){$tal2 = 'b';}
elsif ($tal2 == 12){$tal2 = 'c';}
elsif ($tal2 == 13){$tal2 = 'd';}
elsif ($tal2 == 14){$tal2 = 'e';}
elsif ($tal2 == 15){$tal2 = 'f';}

$result = $tal1.$tal2;

}
return $result;
}

############### make aray of tekst ########################
sub make_array{
my ($text) = $_[0];
$laengde = length($text);
my ($i) = 0;

while ($i != $laengde){
$ord[$i] = substr($text, $i,1);
$i++;
}
return @ord;
}

################### make color array ######################
sub color_array{
local($color1,$color2) = @_;
my($i) = 0;

if ($color1 == $color2){
while ($i < ($laengde - 1)){
$rgb_array[$i] = $color1;
$i++;
}
}else{
$step = int(($color2 - $color1)/($laengde-1));
$rgb_array[0] = $color1;
while ($i < ($laengde - 1)){
$i++;
$rgb_array[$i] = $rgb_array[$i-1] + $step;
}
$rgb_array[$i] = $color2;
}
return &conv_dec_array(@rgb_array);
}


################### convert de

---

"John Doe" <fatih@ofir.dk> writes:
> Jeg har lavet et simpel script. Det tog mig lang tid at finde ud af lave
> det, for jeg vidste ikke hvordan jeg ku' realisere det, og jeg har ikke ret
> meget forstand på at programmere i PERL. Det kan I hurtig se når I kigger på
> mit script.

Al begyndelse er svær. Du har da vist også en C/C++ baggrund ;)

> Scriptet virker som jeg forventede, men det skal vist
> optimeres en lille smule, for scripet virker fint, men hvis man kalder det i
> et andet script så får jeg " not enough memory" og dermed et blank
> skærm.

Hvad mener du med "hvis man kalder det i et andet script"? Kode,
ellers kan vi slet ikke se hvad der er galt.

> Kan mit lille script bruge så meget hukommelse egentlig? Jeg har ikke
> kendskab til moduler og jeg vil helst undgå at bruge dem, for jeg ved ikke
> hvilke moduler jeg har adgang (jeg bruger et eller andet webhotel hallojså).

Du har altid adgang til at bruge moduler, hvis du laver dit script som
et modul. I det kaldende script skriver du:

use lib ".";
use DinPakke;

DinPakke.pm ligger du det samme sted som scriptet, og skriver i den:

package DinPakke;

use strict;

BEGIN {
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION = 1.0;

@ISA = qw(Exporter);
@EXPORT = qw(fade); # hovedfunktionerne som man skal
# kunne kalde
@EXPORT_OK = ();
%EXPORT_TAGS = ();
}

sub dine_funktioner {
...
}

1; # Husk 1 til sidst for at modulet altid giver "true"

Husk også at det er dårlig stil at bruge udokumenterede globale
variable, der initialiseres som sideeffekt i andre funktioner. Det
gør det svært at vedligeholde koden.

Din funktion

> sub join_colors{
> (@join_red,@join_green,@join_red) = @_;
> my($i) = 0;
> while ($i <= $laengde){
> $join_array[$i] = "$join_red[$i]$join_green[$i]$join_blue[$i]";
> $i++;
> }
> return @join_array;
> }

vil ikke virke, men du bruger den heller ikke. For at gøre det du vil
er du nød til at bruge referencer, ala:

@join = &join_colors(\@red,\@green,\@blue);

sub join_colors{
my ($join_red,$join_green,$join_blue) = @_;
my($i) = 0;
while ($i <= $laengde){
  $join_array[$i] = "$join_red->[$i]$join_green->[$i]$join_blue->[$i]";
$i++;
}
return @join_array;
}

Jeg hiver lige fat i resten af dine funktioner og skriver dem om som
jeg ville have skrevet dem. Spørg løs.

sub make_array {
@ord = split //, $_[0];
$laengde = @ord;
}

sub dec_to_hex {
sprintf "%02x", $_[0];
}

sub conv_dec_array{
map { dec_to_hex $_ } @_;
}

sub color_array {
my ($color1, $color2) = @_;

my $step = int(($color2 - $color1) / ($laengde - 1));
my @rgb_array = ();
my $col = $color1;
while (@rgb_array <= $laengde) {
   push @rgb_array, $col;
   $col += $step;
}

conv_dec_array(@rgb_array);
}

Bemærk at du har en lille fejl i fade:

> while ($count <= $laengde){

Det skal være

> while ($count < $laengde){

Godt nytår.
--
Lars Balker Rasmussen "Woo hoo!?"