Waddo
07-16-2008, 11:50 PM
When I'm bored, I do pointless stuff.
There so pointless there useful great anti ban because what macro speaks. . . pig latin =]
My fist probably useless function
function backwards(Sentence:string):string;
var
i:integer;
w:string;
begin
for i:=0 to high(sentence) do
w:=(right(left(sentence,i),1))+w;
result:=w;
end;
How to use
Writeln(backwards('hello'));
Whats it do
Flips a word around.
eg the example above ('hello') would become olleh.
Second
function getdigit(number,pos:integer):integer;
begin
result:=strtoint(right(left(inttostr(number),pos), 1));
end;
What it does.
Returns a single digit from a number
How to use.
writeln(inttostr(getdigit(772472654,5)));
this will return the 5 digit which is 7.
Function number 3
GetDigitsRange - uses getdigit
function getdigitsrange(numb,startpos,endpos:integer):integ er;
var
i:integer;
t:string;
begin
for i:= startpos to endpos do
t:=t+inttostr(getdigit(numb,i));
result:=strtoint(t);
end;
What it does.
Returns a few digits from a number
How to use.
writeln(inttostr(getdigitsrange(772472654,3,5)));
this will return the 3rd to 5th digits which are 247.
My 4th
Function muddle(word:string):string;
var
i,f:integer;
w:string;
begin
for i:=0 to 1 do
for i:=0 to high(word) do
begin
w:=(right(left(word,f),1))+w;
incex(f,2);
if f>high(word) then f:=1;
end;
result:=w;
end;
What does it do.
It muddles up a word im to tired to get it to do what i actually wanted (123456 to 135246) but it will do.
How to use.
writeln(muddle('hello'));
hello becomes olhle.
If you have any ides for other pointless functions that may at some point have a use post. =]
My 5th.
Function despel(word:string):string;
var
i,f,z:integer;
w:string;
begin
z:=1
for i:=0 to 1 do
for i:=0 to high(word) do
begin
w:=w+(right(left(word,f),1));
if random(50)=random(50) then
z:=2;
incex(f,z);
if z=-1 then z:=1;
if z=2 then z:=-1;
if (high(w)=(high(word)-1)) and (random(5)=2) then break;
if (high(w)=(high(word))) then break;
end;
result:=w;
end;
What does it do.
It misspells word's and could be the first usefull thing in here. =]
How do you use.
writeln(despel('hello'));
6th
World prefix generator
program New;
var
prefix:string;
begin
prefix := ReadINI('World' + readln('Enter the world number'), 'Prefix', AppPath + 'includes\SRL\SCSS\worlds.ini');
if(prefix = '')then
begin
writeln('Invalid world number or corrupted world list. Please review your settings');
TerminateScript;
end else
writeln(prefix);
end.
7th
Pig Latin Convertor
function piglatin(word:string):string;
var
I:integer;
suffix:string;
randchar:char;
begin
for i:=1 to high(word) do
begin
case word[i] of
'a', 'e', 'i', 'o' : break;
'u': begin
if i>1 then
if word[i-1]<>'q'then break;
if i=1 then break;
end;
end;
suffix:=suffix+word[i];
end;
case random (3)+1 of
1:randchar:='h';
2:randchar:='w';
3:randchar:='d';
end;
if i=1 then
result:=word+''''+randchar+'ay'
else
result:=right(word,(high(word)-High(suffix)))+''''+suffix+'ay';
end;
What it does.
Converts an English word into Pig Latin.
How to use.
writeln(piglatin('quest'));
program New;
function ConvertCaps(word:string):string;
var
i:integer;
begin
for i := 1 to high(word) do
if inrange(ord(word[i]),65,90) then
result:=result+chr(ord(word[i])+32)
else
result:=result+word[i];
end;
begin
writeln(trimcaps('Hello'));
end.
input 'Hello'
output 'hello'
program New;
function TrimCaps(word:string):string;
var
i:integer;
begin
for i := 1 to high(word) do
if not inrange(ord(word[i]),65,90) then
result:=result+word[i]
end;
begin
writeln(trimcaps('Hello'));
end.
input 'Hello'
ouput 'ello'
Exploder
Program New;
Function ExplodeW(Sentence, SplitAt : String):TStringArray;
var
ArrayPos : Integer;
SentencePos : Integer;
begin
SetArrayLength(result,high(sentence)+1)
for SentencePos := 1 to High(Sentence) do
if Sentence[SentencePos]<>SplitAt then
begin
SetArrayLength(result,high(sentence)+1)
Result[ArrayPos] := Result[ArrayPos]+Sentence[SentencePos];
end else
If High(Result) > 0 then Inc(ArrayPos);
end;
var
words:TStringArray;
i:integer;
begin
words:=ExplodeW('Waddos string exploder',' ');
for i := 0 to high(words) do
writeln(words[i]);
end.
input waddos string exploder
output waddos
string
exploder
function CambridgeSpeak(Word:string):string;
var
Letters:TStringArray;
i:integer;
buildword:string;
begin
setarraylength(letters,high(word)+1);
for i := 2 to high(word) do
letters[i]:=word[i];
begin
for i := 0 to Length(letters) * 3 do
Swap(letters[Random(Length(letters))], letters[Random(Length(letters))]);
buildword:=word[1];
for i := 0 to Min(High(letters), high(word)+1) do
buildword:=buildword+letters[i];
result:=buildword+word[high(word)];
end;
end;
input waddo
output wdado
program New;
procedure LoadUnique1(Strings: TStringArray; Count: Integer);
var
s: TStringList;
Str: string;
i: Integer;
begin
s := TStringList.Create;
while (s.Count < Count) do
begin
Str := Strings[Random(Length(Strings))];
if (s.IndexOf(Str) > -1) then Continue;
s.Add(Str);
end;
for i := 0 to s.Count -1 do
WriteLn(s[i]);
s.Free;
end;
procedure LoadUnique2(Strings: TStringArray; Count: Integer);
var
s: TStringList;
i: Integer;
begin
s := TStringList.Create;
while (Length(Strings) > 0) and (s.Count < Count) do
begin
i := Random(Length(Strings));
s.Add(Strings[i]);
Swap(Strings[i], Strings[High(Strings)]);
SetLength(Strings, High(Strings));
end;
for i := 0 to s.Count -1 do
WriteLn(s[i]);
s.Free;
end;
procedure LoadUnique3(Strings: TStringArray; Count: Integer);
var
i: Integer;
begin
for i := 0 to Length(Strings) * 3 do
Swap(Strings[Random(Length(Strings))], Strings[Random(Length(Strings))]);
for i := 0 to Min(High(Strings), Count - 1) do
WriteLn(Strings[i]);
end;
begin
LoadUnique1(['hello','arfef','magic','srl','scar'], 4);
WriteLn('----');
LoadUnique2(['hello','arfef','magic','srl','scar'], 4);
WriteLn('----');
LoadUnique3(['hello','arfef','magic','srl','scar'], 4);
end.
them 3 things pulls a number of itms from an array will not duplicate positions
they where made by nielsie
this one by me
function loadunique(words:TStringArray;Number:integer):TStr ingArray;
var
Used:TIntegerArray;
Done:integer;
curtry:integer;
count:integer;
isused:boolean;
begin
repeat
begin
isused:=false;
curtry := random(high(words)+1);
for count := 0 to high(used) do
begin
if curtry = used[count] then
isused:= true;
end;
if not isused then
begin
setarraylength(result,getarraylength(result)+1);
setarraylength(used,getarraylength(used)+1);
used[getarraylength(used)-1]:=curtry;
result[getarraylength(result)-1]:= words[curtry];
inc(done);
end;
end;
until done >= number;
end;
var
thing:Tstringarray;
i:integer;
begin
thing:=loadunique(['hello','arfef','magic','srl','scar'],4);
for i := 0 to high(thing) do
writeln(thing[i]);
end.
There so pointless there useful great anti ban because what macro speaks. . . pig latin =]
My fist probably useless function
function backwards(Sentence:string):string;
var
i:integer;
w:string;
begin
for i:=0 to high(sentence) do
w:=(right(left(sentence,i),1))+w;
result:=w;
end;
How to use
Writeln(backwards('hello'));
Whats it do
Flips a word around.
eg the example above ('hello') would become olleh.
Second
function getdigit(number,pos:integer):integer;
begin
result:=strtoint(right(left(inttostr(number),pos), 1));
end;
What it does.
Returns a single digit from a number
How to use.
writeln(inttostr(getdigit(772472654,5)));
this will return the 5 digit which is 7.
Function number 3
GetDigitsRange - uses getdigit
function getdigitsrange(numb,startpos,endpos:integer):integ er;
var
i:integer;
t:string;
begin
for i:= startpos to endpos do
t:=t+inttostr(getdigit(numb,i));
result:=strtoint(t);
end;
What it does.
Returns a few digits from a number
How to use.
writeln(inttostr(getdigitsrange(772472654,3,5)));
this will return the 3rd to 5th digits which are 247.
My 4th
Function muddle(word:string):string;
var
i,f:integer;
w:string;
begin
for i:=0 to 1 do
for i:=0 to high(word) do
begin
w:=(right(left(word,f),1))+w;
incex(f,2);
if f>high(word) then f:=1;
end;
result:=w;
end;
What does it do.
It muddles up a word im to tired to get it to do what i actually wanted (123456 to 135246) but it will do.
How to use.
writeln(muddle('hello'));
hello becomes olhle.
If you have any ides for other pointless functions that may at some point have a use post. =]
My 5th.
Function despel(word:string):string;
var
i,f,z:integer;
w:string;
begin
z:=1
for i:=0 to 1 do
for i:=0 to high(word) do
begin
w:=w+(right(left(word,f),1));
if random(50)=random(50) then
z:=2;
incex(f,z);
if z=-1 then z:=1;
if z=2 then z:=-1;
if (high(w)=(high(word)-1)) and (random(5)=2) then break;
if (high(w)=(high(word))) then break;
end;
result:=w;
end;
What does it do.
It misspells word's and could be the first usefull thing in here. =]
How do you use.
writeln(despel('hello'));
6th
World prefix generator
program New;
var
prefix:string;
begin
prefix := ReadINI('World' + readln('Enter the world number'), 'Prefix', AppPath + 'includes\SRL\SCSS\worlds.ini');
if(prefix = '')then
begin
writeln('Invalid world number or corrupted world list. Please review your settings');
TerminateScript;
end else
writeln(prefix);
end.
7th
Pig Latin Convertor
function piglatin(word:string):string;
var
I:integer;
suffix:string;
randchar:char;
begin
for i:=1 to high(word) do
begin
case word[i] of
'a', 'e', 'i', 'o' : break;
'u': begin
if i>1 then
if word[i-1]<>'q'then break;
if i=1 then break;
end;
end;
suffix:=suffix+word[i];
end;
case random (3)+1 of
1:randchar:='h';
2:randchar:='w';
3:randchar:='d';
end;
if i=1 then
result:=word+''''+randchar+'ay'
else
result:=right(word,(high(word)-High(suffix)))+''''+suffix+'ay';
end;
What it does.
Converts an English word into Pig Latin.
How to use.
writeln(piglatin('quest'));
program New;
function ConvertCaps(word:string):string;
var
i:integer;
begin
for i := 1 to high(word) do
if inrange(ord(word[i]),65,90) then
result:=result+chr(ord(word[i])+32)
else
result:=result+word[i];
end;
begin
writeln(trimcaps('Hello'));
end.
input 'Hello'
output 'hello'
program New;
function TrimCaps(word:string):string;
var
i:integer;
begin
for i := 1 to high(word) do
if not inrange(ord(word[i]),65,90) then
result:=result+word[i]
end;
begin
writeln(trimcaps('Hello'));
end.
input 'Hello'
ouput 'ello'
Exploder
Program New;
Function ExplodeW(Sentence, SplitAt : String):TStringArray;
var
ArrayPos : Integer;
SentencePos : Integer;
begin
SetArrayLength(result,high(sentence)+1)
for SentencePos := 1 to High(Sentence) do
if Sentence[SentencePos]<>SplitAt then
begin
SetArrayLength(result,high(sentence)+1)
Result[ArrayPos] := Result[ArrayPos]+Sentence[SentencePos];
end else
If High(Result) > 0 then Inc(ArrayPos);
end;
var
words:TStringArray;
i:integer;
begin
words:=ExplodeW('Waddos string exploder',' ');
for i := 0 to high(words) do
writeln(words[i]);
end.
input waddos string exploder
output waddos
string
exploder
function CambridgeSpeak(Word:string):string;
var
Letters:TStringArray;
i:integer;
buildword:string;
begin
setarraylength(letters,high(word)+1);
for i := 2 to high(word) do
letters[i]:=word[i];
begin
for i := 0 to Length(letters) * 3 do
Swap(letters[Random(Length(letters))], letters[Random(Length(letters))]);
buildword:=word[1];
for i := 0 to Min(High(letters), high(word)+1) do
buildword:=buildword+letters[i];
result:=buildword+word[high(word)];
end;
end;
input waddo
output wdado
program New;
procedure LoadUnique1(Strings: TStringArray; Count: Integer);
var
s: TStringList;
Str: string;
i: Integer;
begin
s := TStringList.Create;
while (s.Count < Count) do
begin
Str := Strings[Random(Length(Strings))];
if (s.IndexOf(Str) > -1) then Continue;
s.Add(Str);
end;
for i := 0 to s.Count -1 do
WriteLn(s[i]);
s.Free;
end;
procedure LoadUnique2(Strings: TStringArray; Count: Integer);
var
s: TStringList;
i: Integer;
begin
s := TStringList.Create;
while (Length(Strings) > 0) and (s.Count < Count) do
begin
i := Random(Length(Strings));
s.Add(Strings[i]);
Swap(Strings[i], Strings[High(Strings)]);
SetLength(Strings, High(Strings));
end;
for i := 0 to s.Count -1 do
WriteLn(s[i]);
s.Free;
end;
procedure LoadUnique3(Strings: TStringArray; Count: Integer);
var
i: Integer;
begin
for i := 0 to Length(Strings) * 3 do
Swap(Strings[Random(Length(Strings))], Strings[Random(Length(Strings))]);
for i := 0 to Min(High(Strings), Count - 1) do
WriteLn(Strings[i]);
end;
begin
LoadUnique1(['hello','arfef','magic','srl','scar'], 4);
WriteLn('----');
LoadUnique2(['hello','arfef','magic','srl','scar'], 4);
WriteLn('----');
LoadUnique3(['hello','arfef','magic','srl','scar'], 4);
end.
them 3 things pulls a number of itms from an array will not duplicate positions
they where made by nielsie
this one by me
function loadunique(words:TStringArray;Number:integer):TStr ingArray;
var
Used:TIntegerArray;
Done:integer;
curtry:integer;
count:integer;
isused:boolean;
begin
repeat
begin
isused:=false;
curtry := random(high(words)+1);
for count := 0 to high(used) do
begin
if curtry = used[count] then
isused:= true;
end;
if not isused then
begin
setarraylength(result,getarraylength(result)+1);
setarraylength(used,getarraylength(used)+1);
used[getarraylength(used)-1]:=curtry;
result[getarraylength(result)-1]:= words[curtry];
inc(done);
end;
end;
until done >= number;
end;
var
thing:Tstringarray;
i:integer;
begin
thing:=loadunique(['hello','arfef','magic','srl','scar'],4);
for i := 0 to high(thing) do
writeln(thing[i]);
end.