Vinnaren i pepparkakshustävlingen!
2020-05-23, 18:05
  #1
Medlem
(*
Källkod. Program i Pascal, kompileras förslagsvis med FreePascal e.dyl
Programmet försöker förklara den inbyggda meningen i varje
bokstav baserat på bokstavens ordningsföljd i alfabetet.
Specialtecken har anv„nts tillfälligt för att symbolisera
koderna 30..41 .
Varje bokstav/tecken symboliseras av en ljudsignal som
förhoppningsvis är specifik för varje bokstav.
Färger och bas-5 siffersystem är inte tillagda.
Monoljud för närvarande men stereo vore bra, om någon vill
titta på det.
Notera att de första fem symbolerna har en färgkod samt symbol
knuten till sig som jag misstänker är inbyggd i mänsklig "hårdvara".
Symbolerna och färgerna förklaras i kodbeskrivningarna.
Hoppas Ni finner detta användbart.
*)

program Namnljud;
uses Crt;
const
Meanings : array [0..41] of string =
(
'0=life,planet,cell,infinity,all (purple ring)',
'A1=creativity/procreation,won (red vertical line)',
'B2=symmetry/habitual,to (yellow plus sign)',
'C3=construct,group,feces,tree (green triangle)',
'D4=gift,rain,leaf,for (blue triangle with dot in middle)',
'E5=creative gift, inspiration, advice, guidance',
'F6=room,cave,space,cube,deal between two groups',
'G7=the tree and its leaf, maternity, creative cave,habitual advisory role',
'H8=tesseract,hypercube,dream,sleep,infinite',
'I9=qualified majority will win, three groups, friendly advice, disagreement, conflict',
'J10=sperm and egg, solitude, searching, alone, dream of symmetries, two rainy gifts in symmetry',
'K11=orgasm, dreaming of a group, habitual conflict',
'L12=society, the infinite gift, dreaming in rain, safe, comfort',
'M13=anxiety, lone construct, homesick, mother unreachable,abandonment,expelled, unwanted, outcast',
'N14=satisfaction, two advisors, strength, normal society, content, assurance, agreements, masturbation',
'O15=perfection,harmony,complete,too good to be true, falling in love',
'P16=responsibility,adult,work,serious,diligent',
'Q17=sworn,official couple,marriage,diamond ring,oath,faithful',
'R18=threats,discussions,arguing,upset,anger',
'S19=deceit,covert,intrigue,jealous,calculating,de ceptive',
'T20=chaos,confusion,panic,separation,torn apart',
'U21=war,attack,strike,battle,tactics',
'V22=division,split,goodbyes,take off to build another society',
'W23=suffering,hurt,pain,turmoil,misery,blood',
'X24=destruction,annihilation,crushing,break,oblit erate',
'Y25=choice,advice in chaos, fork in road, selection',
'Z26=nightmare, threatening dream, psychosis, unreal, crazy',
'Å27=consensus,mutual understanding',
'Ä28=love, mutual equally beneficial relation',
'Ö29=the physical act of making love',
'=30=balance of power',
'*31=infinite sufferings',
'/32=infinite destructions',
'+33=infinite choices',
'-34=infinite nightmares',
'&35=infinite consensii',
',36=infinite moments of mutually beneficial relations',
'!37=infinite momentary acts of mutually beneficial relations',
'^38=revolution,uprising',
' 39=murder,kill,execute',
'%40=genocide',
'?41=who knows what this one is, not me anyway...'

); { exempel }

LettersSmall = 'abcdefghijklmnopqrstuvwxyzåäö=*/+-&,!^ %?'; { exempel }
LettersLarge = 'ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖ=*/+-&,!^ %?'; { exempel }
var
Firstn,Surn : string;
FM,SM,RM : Byte;

function GetValue (c : char) : Byte;
var
N,Loop : Byte;
begin
N := 0;
for Loop := 1 to Length (LettersSmall) do
if (c=LettersSmall [Loop]) or (c=Letterslarge [Loop]) then N := Loop;
GetValue := N;
end;

procedure ReadCharAloud (c : char);
var
r,lowest,highest,average : real;
Loop : Byte;
St : string;
v,ov : Byte;
begin
r := GetValue (c);
if r>0 then
begin
r := 2 / r;
Str (r,St);
WriteLn (c);
ov := 10;
lowest := Ord (St [2])-48;
highest := 0;
average := 0;
for Loop := 4 to 18 do
begin
r := Ord (St [Loop])-48;
r := r * r;
if r>highest then highest := r;
average := average + r;
end;
average := (average * 49) / 16;
highest := highest * 49;
lowest := lowest * lowest * 49;
Sound (trunc (lowest)+49); Delay (98+98); { +49 = safety }
Sound (trunc (average)+49); Delay (98+98);
Sound (trunc (highest)+49); Delay (98+98);
Sound (trunc (average)+49); Delay (98+98);
end else begin Nosound; Delay (98+98); end;
end;

procedure ReadAloud (St : string);
var
Loop : Byte;
begin
for Loop := 1 to Length (St) do ReadCharAloud (St [Loop]);
NoSound;
end;

begin
Randomize;
ClrScr;
WriteLn;
repeat
WriteLn ('Random names as sound. Press <Enter> to exit.');
Firstn := Chr (Random (26)+65);
Surn := Chr (Random (26)+65);
repeat
if Random (2)=0 then Firstn := Firstn + Chr (Random (26)+97) else
Surn := Surn + Chr (Random (26)+97)
until Length (Firstn+Surn)>13;
WriteLn;
WriteLn (Firstn+' '+Surn);
if (Firstn<>'') and (Surn<>'') then
begin
ReadAloud (Firstn);
Delay (849);
WriteLn;
ReadAloud (Surn);
Delay (849);
FM := GetValue (Firstn [Length (Firstn)]);
SM := GetValue (Surn [1]);
WriteLn ('That means:');
WriteLn (Meanings [FM]);
WriteLn ('in combination with');
WriteLn (Meanings [SM]);
WriteLn;
RM := FM+SM;
if RM>41 then WriteLn ('Result undefined at this time.') else
begin
WriteLn ('Brain speculates this will lead to:');
WriteLn (Meanings [RM]);
WriteLn (',..');
ReadAloud (Meanings [RM][1]);
WriteLn;
Delay (849);
WriteLn (Meanings [RM]);
WriteLn ('.,.');
ReadAloud (Meanings [RM][1]);
WriteLn;
Delay (849);
WriteLn (Meanings [RM]);
WriteLn ('..,');
ReadAloud (Meanings [RM][1]);
WriteLn;
Delay (849);

end;
end;
until Keypressed and (ReadKey=#13);
end.
2020-05-23, 18:48
  #2
Medlem
Vad är din fråga egentligen? Nu när du ställer den till ett språkforum.
Det här tycks iaf vara något slags dataprogrammering.
2020-05-24, 09:31
  #3
Moderator
Kyrpators avatar
Den här trådstarten tycks ha hamnat i helt fel forum. Vi låser den tillsvidare. /Mod.

Stöd Flashback

Flashback finansieras genom donationer från våra medlemmar och besökare. Det är med hjälp av dig vi kan fortsätta erbjuda en fri samhällsdebatt. Tack för ditt stöd!

Stöd Flashback