I want to understand this code, especially PROCEDURE
PROGRAM vowels;
USES crt;
{Program that counts the number of vowels in a sentence}
CONST space=' ';
maxchar=80;
TYPE vowel=(a,e,i,o,u);
VAR buffer:ARRAY[1..maxchar] of char;
vowelcount:ARRAY[vowel] of integer;
PROCEDURE initialize;
VAR ch:vowel;
BEGIN
FOR ch:=a TO u DO
BEGIN
vowelcount[ch]:=0;
END;
END;
PROCEDURE textinput;
VAR index:integer;
BEGIN
writeln('Input a sentence');
FOR index:=1 TO maxchar DO
IF eoln THEN buffer[index]:=space
ELSE read(buffer[index]);
readln;
END;
PROCEDURE analysis;
VAR index:integer;
ch:vowel;
BEGIN
index:=1;
WHILE index<>maxchar+1 DO
BEGIN
IF buffer[index] IN ['a','e','i','o','u'] THEN
BEGIN
CASE buffer[index] OF
'a':ch:=a;
'e':ch:=e;
'i':ch:=i;
'o':ch:=o;
'u':ch:=u;
END;
vowelcount[ch]:=vowelcount[ch]+1;
END;
index:=index+1;
END;
END;
PROCEDURE vowelout;
VAR ch:vowel;
BEGIN
clrscr;
writeln;
writeln(' a e i o u');
FOR ch:=a TO u DO
write(vowelcount[ch]:4);
writeln;
END;
BEGIN
initialize;
textinput;
analysis;
vowelout;
END;
Overall: Okay this code is counting the number of vowels supplied in the input string.
Lets Begin....
TYPE vowel=(a,e,i,o,u); VAR
buffer:ARRAY[1..maxchar] of char;
vowelcount:ARRAY[vowel] of integer;
This code is defining a list of the vowels in english (a,e,i,o,u).
PROCEDURE initialize; VAR ch:vowel;
BEGIN FOR ch:=a TO u DO BEGIN
vowelcount[ch]:=0; END; END;
It then defines a variable to collect the number of each vowel, called vowelcount. That variable is an array, looks sort of like this:
vowelcount[a]=0;
vowelcount[e]=0;
vowelcount[i]=0; #... etc
Then the procedure "Analysis" is defined. This takes the input from the screen (which will be called later on in the program) and steps through each letter in the input.
WHILE index<>maxchar+1 DO BEGIN IF
buffer[index] IN ['a','e','i','o','u']
THEN BEGIN CASE buffer[index] OF
'a':ch:=a; 'e':ch:=e; 'i':ch:=i;
'o':ch:=o; 'u':ch:=u; END;
If any of those letters happens to be in the list of letters than matches a vowel, then it will add one to the number in the vowelcount array above. (vowelcount[ch]:=vowelcount[ch]+1) where ch is the matched letter. As you can see this is only triggered if it is a valid vowel (IF buffer[index] IN ['a','e','i','o','u'] )
Finally. The main code of the program, or what is actually run:
BEGIN clrscr; writeln; writeln(' a e i
o u'); FOR ch:=a TO u DO
write(vowelcount[ch]:4); writeln; END;
BEGIN initialize; textinput; analysis;
vowelout; END.
This basically strings the application together, starting by clearing the screen (in a dos prompt) and then outputting the vowels onto the screen. It then adds some formatting and outputs the current count of vowelcount (as above).
It will then request your input and finally it will output the contents of vowelcount again, which has been updated with the vowelcounts from the input you made.
Related
I have tried to make a simple snake game with Free Pascal, when I started the programme, it drew the map exactly what I want but after that, I pressed the button that I have set to control the snake and it exited with exit code 201.
I don't know much about that exit code, could you explain me the problems of the programme? This is the longest program I have ever made with Pascal.
Here is the code:
uses crt;
type
ran=record
x:byte;
y:byte;
end;
var
f:ran;
s:array[1..1000] of ran;
i,j:longint;
st,l:byte;
function getkey:integer;
var
k:integer;
begin
k:=ord(readkey);
if k=0 then k:=-ord(readkey);
getkey:=k;
end;
procedure fa;
begin
randomize;
f.x:=random(98)+1;
f.y:=random(23)+1;
gotoxy(f.x,f.y);
writeln('o');
end;
procedure draw;
begin
gotoxy(1,1);
st:=1;
for i:=1 to 25 do begin
for j:=1 to 100 do write('X');
writeln
end;
gotoxy(st+1,st+1);
for i:=1 to 23 do begin
for j:=1 to 98 do write(' ');
gotoxy(st+1,i+2);
end;
end;
procedure sts;
begin
s[1].x:=19;
s[1].y:=6;
gotoxy(s[1].x,s[1].y);
writeln('#');
end;
procedure fa1;
begin
f.x:=29;
f.y:=5;
gotoxy(f.x,f.y);
writeln('o');
end;
procedure eat;
begin
if (s[1].x=f.x) and (s[1].y=f.y) then begin
l:=l+1;
fa;
end;
end;
function die:boolean;
begin
die:=false;
if (s[1].x=1) or (s[1].x=100) or (s[1].y=1) or (s[1].y=25) then
die:=true;
if l>=5 then
for i:=5 to l do
if (s[1].x=s[i].x) and (s[1].y=s[i].y) then
die:=true;
end;
procedure up;
begin
for i:=l downto 2 do begin
s[i].y:=s[i-1].y;
gotoxy(s[i].x,s[i].y);
writeln('+');
end;
gotoxy(s[l].x,s[l].y+1);
writeln(' ');
s[1].y:=s[1].y-1;
gotoxy(s[1].x,s[1].y);
writeln('#');
end;
procedure down;
begin
for i:=l downto 2 do begin
s[i].y:=s[i-1].y;
gotoxy(s[i].x,s[i].y);
writeln('+');
end;
gotoxy(s[l].x,s[l].y-1);
writeln(' ');
s[1].y:=s[1].y+1;
gotoxy(s[1].x,s[1].y);
writeln('#');
end;
procedure left;
begin
for i:=l downto 2 do begin
s[i].x:=s[i-1].x;
gotoxy(s[i].x,s[i].y);
writeln('+');
end;
gotoxy(s[l].x+1,s[l].y);
writeln(' ');
s[1].x:=s[1].x-1;
gotoxy(s[1].x,s[1].y);
writeln('#');
end;
procedure right;
begin
for i:=l downto 2 do begin
s[i].x:=s[i-1].x;
gotoxy(s[i].x,s[i].y);
writeln('+');
end;
gotoxy(s[l].x-1,s[l].y);
writeln(' ');
s[1].x:=s[1].x+1;
gotoxy(s[1].x,s[1].y);
writeln('#');
end;
procedure auto(k:integer);
begin
case k of
-72:up;
-80:down;
-75:left;
-77:right;
119:up;
115:down;
97:left;
100:right;
end;
end;
procedure ingame(t:integer);
var
d,e:boolean;
begin
repeat
auto(t);
d:=die;
if d=true then exit;
eat;
until (keypressed);
if keypressed then t:=getkey;
case t of
-72:up;
-80:down;
-75:left;
-77:right;
119:up;
115:down;
97:left;
100:right;
end;
eat;
d:=die;
if d=true then exit;
end;
procedure first;
var
k:integer;
begin
draw;
fa1;
sts;
if keypressed then k:=getkey;
ingame(k);
end;
BEGIN
clrscr;
first;
readln
END.
I googled this: 201 : range error, so you probably go out of array bounds. The only array s in indexed by variables that depend on l value (weird name, BTW). But I see a single place where you do changing (increment) this variable and don't see any l initialization. So you are using arbitrary starting value (here perhaps zero because l is global).
Note that you could discover this bug (and perhaps others) with simple debugging.
The code 201 seems to be explained for example here: Runtime Error 201 at fpc
Exactly why this happens in your code, I don't know.
I want to find all the posibilities of moving around these numbers 1,2,3,4,5 with the conditions that "4,3" is not possible and 1 and 5 can't be in the same solution. I have this code but when I compile it it doesn't show me anything.
var x:array[1..50] of integer;
i,k:integer;
avems,evalid:boolean;
procedure init;
begin
x[k]:=0;
end;
procedure succesor;
begin
if x[k]<5 then avems:=true
else avems:=false;
if avems=true then x[k]:=x[k]+1;
end;
function solutie:boolean;
begin
if k=3 then solutie:=true
else solutie:=false;
end;
procedure valid;
begin
evalid:=true;
for i:=1 to k-1 do
if (x[i]=1) or (x[i]=5) and (x[k]=1) or (x[k]=5) then evalid:=false;
if (k>1) and (x[k-1]=4) and (x[k]=3) then evalid:=false;
end;
procedure tipar;
begin
for i:=1 to 3 do
write(x[i],' ');
writeln;
end;
begin
k:=1;
init;
while k>0 do
begin
repeat
succesor;
until not(avems) or (avems and evalid);
if avems then
if solutie then tipar
else begin
k:=k+1;
init;
end
else k:=k-1;
end;
end.
What do you expect? Your code increments x[1] until it reaches 5, then sets avems:=false; and then decrements k to zero and exits the while loop.
Remember that Pascal does not use indentation for blocks like Python, so your
last steps are written more clearly as
if avems then begin
if solutie then tipar
else begin
k:=k+1;
init;
end
end
else k:=k-1;
If this is not what you want, you have to code some begin/end.
program ZZX1;
{$mode objfpc}{$H+}
uses
crt,
wincrt,
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this };
type
Masquerader = record
Name, CountyCode: string;
Payment: real;
end;
var
Applicant: array[1..10] of Masquerader;
DemList: array[1..10] of string;
BerList: array[1..10] of string;
EsqList: array[1..10] of string;
x:integer;
Y:integer;
DemCounter:integer;
BerCounter:integer;
EsqCounter:integer;
DemAmount:real;
BerAmount:real;
EsqAmount:real;
procedure LoadData;
begin
clrscr;
X:=0;
DemCounter:=0;
BerCounter:=0;
EsqCounter:=0;
DemAmount:=0;
BerAmount:=0;
EsqAmount:=0;
repeat
X:= x+1;
repeat
write('Enter Your County Code DemM or BerM or EsqM: ');
readln(Applicant[x].CountyCode);
until (Applicant[x].CountyCode= 'DemM') or (Applicant[x].CountyCode= 'BerM') or (Applicant[x].CountyCode= 'EsqM');
If Applicant[x].CountyCode = 'DemM' then
begin
write('Enter Your Name: ');
readln(Applicant[x].Name);
write('Enter Your Total Payment: ');
readln(Applicant[x].Payment);
clrscr;
DemCounter:= DemCounter + 1;
DemAmount:= DemAmount + Applicant[x].Payment;
DemList[DemCounter]:= Applicant[x].Name;
end;
If Applicant[x].CountyCode = 'BerM' then
begin
write('Enter Your Name: ');
readln(Applicant[x].Name);
write('Enter Your Total Payment: ');
readln(Applicant[x].Payment);
clrscr;
BerCounter:= BerCounter + 1;
BerAmount:= BerAmount + Applicant[x].Payment;
BerList[BerCounter]:= Applicant[x].Name;
end;
If Applicant[x].CountyCode = 'EsqM' then
begin
write('Enter Your Name: ');
readln(Applicant[x].Name);
write('Enter Your Total Payment: ');
readln(Applicant[x].Payment);
clrscr;
EsqCounter:= EsqCounter + 1;
EsqAmount:= EsqAmount + Applicant[x].Payment;
EsqList[EsqCounter]:= Applicant[x].Name;
end;
until x=6 ;
end;
Procedure PrintData;
begin
Y:= 0;
for y := 1 to 6 do
begin
writeln('Name: ', Applicant[y].Name);
writeln('CountyCode: ', Applicant[y].CountyCode);
writeln('Payment: ', Applicant[y].Payment:0:2);
writeln;
end;
For Y:= 1 to DemCounter do
begin
writeln(DemList[Y]);
writeln(DemCounter,'',' persons are registered in Demerara');
writeln;
writeln('DemTotal:$ ', DemAmount:0:2);
end;
For Y:= 1 to BerCounter do
begin
writeln(BerList[Y]);
writeln(BerCounter,'',' persons are registered in Berbice');
writeln;
writeln('BerTotal:$ ', BerAmount:0:2);
end;
For Y:= 1 to EsqCounter do
begin
writeln(EsqList[Y]);
writeln(EsqCounter,'',' persons are registered in Essequibo');
writeln;
writeln('EsqTotal:$ ', EsqAmount:0:2);
end;
end;
Procedure quit;
begin
writeln('Press <Enter> To Quit');
readln;
end;
begin
LoadData;
PrintData;
quit;
end.
This program currently collects 6 persons and groups them by their countycode, calculating the total amount of persons and money collected by each county.
When I run the program below my expected output is on the screen for a few seconds then it disappears leaving only a piece of the expected output( The end Part). Please assist.
If there are characters in the keyboard buffer when the program reaches the readln; statement in the procedure quit, readln will read those characters and continue onwards rather than waiting for further input before continuing.
To check this, try adding a character variable as a parameter to readln and write the ASCII value of the character out (or check its value in a debugger) to see if there is anything in that variable after the readln.
(EDIT)
After further thinking, I wonder if the code like:
For Y:= 1 to EsqCounter do
begin
writeln(EsqList[Y]);
writeln(EsqCounter,'',' persons are registered in Essequibo');
writeln;
writeln('EsqTotal:$ ', EsqAmount:0:2);
end;
... should actually read something like:
For Y:= 1 to EsqCounter do
begin
writeln(EsqList[Y]);
end;
writeln(EsqCounter,'',' persons are registered in Essequibo');
writeln;
writeln('EsqTotal:$ ', EsqAmount:0:2);
... because otherwise the same values of EsqCounter and EsqTotal will be output EsqCounter times, which seems unnecessary.
I've got rows of two values (input from console) that look likes this:
David 89000
Peter 99500
Jim 23999
END 1
is there a way to save the string and number into a variable other than to loop-read a char when you don't know the string length?
str:=''; salary:=0; i:=1;
while str<> 'END' do
begin
str:=''; salary:=0;
read(ch);
while ch <> ' ' do
begin
str:=str+ch;
read(ch);
end;
read(salary);
array[i].name:=str;
array[i].salary:=salary;
i:=i+1;
readln;
end;
You can do it with a single call to ReadLn and then parse the input yourself:
var
TextIn: string;
Person: string;
Salary: Integer;
begin
while true do
begin
ReadLn(TextIn); // Requires user to hit Enter
if Copy(TextIn, 1, 3) <> 'END' then
begin
Person := Copy(TextIn, 1, Pos(' ', TextIn) - 1);
Salary := StrToInt(Copy(TextIn, Pos(' ', TextIn) + 1, 255);
end
else
Exit;
end;
end;
I didn't include any error checking (which should be there), because your original code doesn't have any either.
Not with standard I/O functions. Of course you can put that code in a separate procedure, or split with tstringlist.
I have using pascal for my parallel language .(I don't like it , but force.) So the
Merge sort in parallel with fork & join not working, can some one tell me why?
here is my code :
program parrallelmergesort;
architecture shared(100);
const
n=100;(*big array*)
size=10;
var
t,globalCounter:integer;
unsorted:array[1..n] of integer;
procedure CallMerge(var lower,mid,high:integer);
var
i,j,k,count:integer;
S:array[1..n] of integer;
BEGIN
i:=lower;
j:=mid+1;
k:=lower;
count:=high-lower+1;
while (i<=mid) and (j<=high) do
begin
if unsorted[i]<unsorted[j] then
begin
S[k] :=unsorted[i];
i :=i+1;
end
else
begin
S[k] :=unsorted[j];
j :=j+1;
end;
k:=k+1;
end;
if i>mid then
begin
while j<=high do
begin
S[k] :=unsorted[j];
j :=j+1;
k :=k+1;
end;
end
else if j>high then
begin
while i<=mid do
begin
S[k] :=unsorted[i];
i :=i+1;
k :=k+1;
end;
end;
for t:=lower to high do
unsorted[t] :=S[t];
end;
procedure CallMergeSort(bottom,up:integer);
var middle,nextOfMiddle:integer;
begin
if up>bottom then
begin
middle := (up+bottom) div 2;
nextofMiddle :=middle+1;
fork CallMergeSort(bottom,middle);
fork CallMergeSort(nextOfMiddle,up);
join;join;
CallMerge(bottom,middle,up);
end;
end;
begin
unsorted[1] :=4; unsorted[2] :=3; unsorted[3] :=10; unsorted[4] :=5; unsorted[5] :=0;
unsorted[6] :=1; unsorted[7] :=8; unsorted[8] :=6; unsorted[9] :=11; unsorted[10] :=12;
CallMergeSort(1,size);
for globalCounter:=1 to size do
writeln(unsorted[globalCounter]);
readln;
end.
When should I use fork ? before CallMergeSort (Recursive) ?
Last lines is main function in pascal.
don't call fork and join inside the rec function.
Just call them twice from the main.