so i need to create a food ordering system in pascal , i have done the program but the program only give me one line of food when i ordered 2 or more types of food
program orderfood;
var
choice,ramen,sashimi,nigi,tei:integer;
nramen,nsashimi,nnigi,ntei:integer;
Money:Text;
count:integer;
NigiMoney,RamenMoney,TeiMoney,SashimiMoney,FinalMoney:integer;
TeiName,RamenName,SashimiName,NigiName,i:string;
a:array [1..4] of string;
b:integer;
procedure Menu;
begin
writeln('/===============\');
writeln('|Welcome to the |');
writeln('| Japan House! |');
writeln('| 1. Ramen |');
writeln('| 2. Sashimi |');
writeln('| 3. Nigirizushi|');
writeln('| 4. Teishoku |');
writeln('| 5. Receipt |');
writeln('| 9. Leave |');
writeln('\===============/');
writeln('Please Enter your choice!');
readln(choice);
end;
procedure OrderRamen;
begin
writeln('Choice For Ramen:');
writeln('1.Shoyu Ramen $38');
writeln('2.Tonkotsu Ramen $37');
writeln('3.Shio Ramen $35');
writeln('4.Miso Ramen $39');
writeln('5.Tsukemen $45');
writeln('6.Instant Ramen Noddles $30');
writeln('Previous =0');
writeln('Enter your choice: ');
readln(ramen);
case ramen of
1:RamenName:='Shoyu Ramen';
2:RamenName:='Tonkotsu Ramen';
3:RamenName:='Shio Ramen';
4:RamenName:='Miso Ramen';
5:RamenName:='Tsukemen';
6:RamenName:='Instant Ramen Noddles';
end;
if ramen=0
then Menu
else write('How many ramen do you want ? ');
readln(nramen);
if nramen>1 then
case ramen of
1:RamenMoney:=nramen*13;
2:RamenMoney:=nramen*20;
3:RamenMoney:=nramen*18;
4:RamenMoney:=nramen*15;
5:RamenMoney:=nramen*22;
6:RamenMoney:=nramen*22;
end;
if nramen=1 then
case ramen of
1:RamenMoney:=13;
2:RamenMoney:=20;
3:RamenMoney:=18;
4:RamenMoney:=15;
5:RamenMoney:=22;
6:RamenMoney:=22;
end;
end;
procedure OrderSashimi;
begin
writeln('Choice For Sashimi:');
writeln('1.Sake $41');
writeln('2.Akami $40');
writeln('3.Chutoro $50');
writeln('4.Otoro $70');
writeln('5.Hotate $45');
writeln('6.Ikura $40');
writeln('Previous =0');
writeln('Enter your choice: ');
readln(sashimi);
case sashimi of
1:SashimiName:='Sake';
2:SashimiName:='Akami';
3:SashimiName:='Chutoro';
4:SashimiName:='Otoro';
5:SashimiName:='Hotate';
6:SashimiName:='Ikura';
end;
if sashimi=0
then Menu
else write('How many sashimi do you want ? ');
readln(nsashimi);
if nsashimi>1 then
case sashimi of
1:SashimiMoney:=nsashimi*13;
2:SashimiMoney:=nsashimi*20;
3:SashimiMoney:=nsashimi*18;
4:SashimiMoney:=nsashimi*15;
5:SashimiMoney:=nsashimi*22;
6:SashimiMoney:=nsashimi*22;
end;
if nsashimi=1 then
case sashimi of
1:SashimiMoney:=13;
2:SashimiMoney:=20;
3:SashimiMoney:=18;
4:SashimiMoney:=15;
5:SashimiMoney:=22;
6:SashimiMoney:=22;
end;
end;
procedure OrderNigirizushi;
begin
nigi:=0;
writeln('Choice For Nigirizushi:');
writeln('1.Tamago $13');
writeln('2.Sake $20');
writeln('3.Maguro $18');
writeln('4.Ebi $15');
writeln('5.Ikuro $22');
writeln('6.Kani $20');
writeln('Previous =0');
writeln('Enter your choice: ');
readln(nigi);
case nigi of
1:NigiName:='Tamago';
2:NigiName:='Sake';
3:NigiName:='Maguro';
4:NigiName:='Ebi';
5:NigiName:='Ikuro';
6:NigiName:='Kani';
end;
if nigi=0
then Menu
else write('How many nigirizushi do you want ? ');
readln(nnigi);
if nnigi>1 then
case nigi of
1:NigiMoney:=nnigi*13;
2:NigiMoney:=nnigi*20;
3:NigiMoney:=nnigi*18;
4:NigiMoney:=nnigi*15;
5:NigiMoney:=nnigi*22;
6:NigiMoney:=nnigi*22;
end;
if nnigi=1 then
case nigi of
1:NigiMoney:=13;
2:NigiMoney:=20;
3:NigiMoney:=18;
4:NigiMoney:=15;
5:NigiMoney:=22;
6:NigiMoney:=22;
end;
end;
procedure OrderTeishoku;
begin
writeln('Choice For Teishoku:');
writeln('1.Kara-Age Teishoku $45');
writeln('2.Tonkatsu Teishoku $40');
writeln('3.Sashimi Teishoku $35');
writeln('4.Mix Fry Teishoku $39');
writeln('Previous =0');
writeln('Enter your choice: ');
readln(tei);
if tei=0
then Menu
else write('How many Teishoku do you want ? ');
readln(ntei);
case tei of
1:TeiName:='Kara-Age Teishoku';
2:TeiName:='Tonkatsu Teishoku';
3:TeiName:='Sashimi Teishoku';
4:TeiName:='Mix Fry Teishoku';
end;
if ntei>1 then
case ntei of
1:TeiMoney:=ntei*13;
2:TeiMoney:=ntei*20;
3:TeiMoney:=ntei*18;
4:TeiMoney:=ntei*15;
5:TeiMoney:=ntei*22;
6:TeiMoney:=ntei*22;
end;
if ntei=1 then
case tei of
1:TeiMoney:=13;
2:TeiMoney:=20;
3:TeiMoney:=18;
4:TeiMoney:=15;
5:TeiMoney:=22;
6:TeiMoney:=22;
end;
end;
procedure StoreMoney1;
begin
Assign(Money,'C:\Users\jason\Desktop\Ho Chung Hin Sba\real
pg\Money.txt');
rewrite(Money);
writeln(Money,RamenName,' ','*',nramen,' ',RamenMoney);
close(Money);
end;
procedure StoreMoney2;
begin
Assign(Money,'C:\Users\jason\Desktop\Ho Chung Hin Sba\real
pg\Money.txt');
rewrite(Money);
writeln(Money,NigiName,' ','*',nnigi,' ',NigiMoney);
close(Money);
end;
procedure StoreMoney3;
begin
Assign(Money,'C:\Users\jason\Desktop\Ho Chung Hin Sba\real
pg\Money.txt');
rewrite(Money);
writeln(Money,TeiName,' ','*',ntei,' ',TeiMoney);
close(Money);
end;
procedure StoreMoney4;
begin
Assign(Money,'C:\Users\jason\Desktop\Ho Chung Hin Sba\real
pg\Money.txt');
rewrite(Money);
writeln(Money,SashimiName,' ','*',nsashimi,' ',SashimiMoney);
close(Money);
end;
Procedure PrintOut;
begin
b:=1;
reset(Money);
while not EOF(Money) do
begin
readln(Money,i);
a[b]:=i;
writeln(a[b]);
b:=b+1;
end;
close(Money);
end;
begin
repeat
begin
Menu
end;
if choice=1 then
begin
OrderRamen;
StoreMoney1;
end
else if choice=2 then
begin
OrderNigirizushi;
StoreMoney2;
end
else if choice=3 then
begin
OrderTeishoku;
StoreMoney3;
end
else if choice=4 then
begin
OrderSashimi;
StoreMoney4;
end;
until choice=5;
if choice=5 then
begin
PrintOut
end;
if choice=9 then
exit;
end.
Result and input:
input 1 1 1 , 2 1 1
result : Detail of 2 but no 1
please help!
Your StoreMoney procedures all open the text file for writing, discarding the content previously written. You need to find the compiler's procedure/function that will open the text file for writing-with-append. I have seen several ways of doing this, such as Append(f) and Open(f,'a'), as well as object-oriented (or pseudo-object-oriented) styles such as F.Open('a') or F.Append().
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.
So i'm using pascal, and i want to add multiple statements to one case. I tried this code but i get the error:
"Error: Constant and CASE types do not match"
procedure pay;
begin
loop:=loop+1;
CASE loop OF
1:
writeln('E-Mail: ');
readln(mailO[1]);
writeln('amount: ');
readln(amount[1]);
end;
Wrap compound statements in a begin and end:
procedure pay;
begin
loop:=loop+1;
CASE loop OF
1:
begin
writeln('E-Mail: ');
readln(mailO[1]);
writeln('amount: ');
readln(amount[1]);
end;
2: writeln('simple statement');
3: begin
writeln('something else');
writeln('etc.');
end;
end;
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 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.