Pascal list issue - pascal

I'm facing an issue connected with lists in Pascal right now.
When I add a person it goes successfully, but when I want to add next person it throws an error:
Ide: Lazarus.
Code (at the start of the code the head is equal to nil):
TYPE
Person = RECORD
name: STRING[15];
last_name: STRING[15];
age: INTEGER;
end;
pListElement = ^ListElement;
ListElement = RECORD
person: ^Person;
next: pListElement;
end;
PROCEDURE AddPerson(var head: pListElement);
PROCEDURE ShowPersons(var head: pListElement);
implementation
PROCEDURE AddPerson(var head: pListElement);
Var NewPerson: pListElement;
Begin
new(NewPerson);
Write(' Podaj imie: ');
readln(NewPerson^.Person^.name);
Write(' Podaj nazwisko: ');
readln(NewPerson^.Person^.last_name);
Write(' Podaj wiek: ');
readln(NewPerson^.Person^.age);
if (head = NIL) THEN
begin
head:= NewPerson;
NewPerson^.next:= nil;
end else
begin
NewPerson^.next:= head;
NewPerson:= head;
end;
End;
PROCEDURE ShowPersons(var head: pListElement);
Begin
if (head <> NIL) THEN
begin
WriteLn(' | ', head^.Person^.name:15, ' | ', head^.Person^.last_name:15, ' | ', head^.Person^.age:3, ' |');
ShowPersons(head^.next);
end;
End;

The problem is that while you make a new ListElement record in Addperson, you then assume the Person is magically initialized. It isn't. It needs to be looked up or created (new()'ed), depending on what it is actually good for.

Related

Pascal Text Menu Music Player

I need help with creating my music player, I'm receiving the same error and can't seem to get past it. Thank you.
I've attached my code below, as well as my errors.
Errors:
Free Pascal Compiler version 2.6.4 [2014/02/26] for i386 Copyright (c)
1993-2014 by Florian Klaempfl and others Target OS: Darwin for i386
Compiling MusicPlayer.pas
MusicPlayer.pas(82,37) Error: Incompatible type for arg no. 1: Got "ShortString", expected "Album"
MusicPlayer.pas(138,31) Error: Incompatible type for arg no. 1: Got
"albumArray", expected "Album"
MusicPlayer.pas(164,44) Error: Incompatible type for arg no. 1: Got "albumArray", expected "Album"
MusicPlayer.pas(174) Fatal: There were 3 errors compiling module,
stopping Fatal: Compilation aborted Error: /usr/local/bin/ppc386
returned an error exitcode (normal if you did not specify a source
file to be compiled)
program MusicPlayer;
uses TerminalUserInput;
type
Track = record
trackName: String;
location: String;
end;
TrackArray = array of Track;
Album = record
albumName: String;
artistName: String;
genre: String;
track: TrackArray;
// key: Integer;
trackNum: Integer;
fileName: String;
end;
albumArray = array of Album;
function GetAlbums(): albumArray;
var
// anAlbum: Album;
//albums: albumArray;
fileName: String;
myFile: TextFile;
numOfAlb: Integer;
trackNum: Integer;
i: Integer;
j: Integer;
begin
fileName := ReadString('Enter filename: ');
AssignFile(myFile, fileName);
// AssignFile(myFile, 'albums.dat');
Reset(myFile);
ReadLn(myFile, numOfAlb);
setLength(result, numOfAlb);
for i:= 0 to High(result) do
begin
ReadLn(myFile, result[i].albumname);
ReadLn(myFile, result[i].artistName);
ReadLn(myFile, result[i].genre);
ReadLn(myFile, trackNum);
setLength(result[i].track, trackNum);
for j:= 0 to trackNum -1 do
begin
ReadLn(myFile, result[i].track[j].trackName);
ReadLn(myFile, result[i].track[j].location);
end;
end;
end;
procedure DisplayAlbum(a: Album);
var
//t: Track;
i: Integer;
begin
WriteLn('Album name is: ', a.albumName);
WriteLn('Album artist name is: ', a.artistName);
WriteLn('Album genre is: ', a.genre);
WriteLn('Number of tracks are: ', a.trackNum);
for i:= 0 to High(a.track) do
begin
WriteLn('Track name is: ', a.track[i].trackName);
WriteLn('Album name is: ', a.track[i].location);
end;
end;
function PrintAllGenres(albums: albumArray): albumArray;
var
i: Integer;
begin
for i := 0 to High(albums) do
begin
DisplayAlbum(albums[i].genre);
end;
end;
procedure SelectAlbum(const albums: albumArray);
var
val: Integer;
i: Integer;
begin
WriteLn('<< Welcome to the Track Player >>');
val := ReadInteger('Enter an Album''s key number: ');
for i := 0 to High(albums) do
begin
WriteLn('Album is now playing.');
end;
if (i > High(albums)) then
begin
WriteLn('Album was not found, now returning to Main Menu ');
end;
end;
function UpdateAlbum(a: Album): Album;
begin
a.albumName := ReadString('Please enter a new name for this album: ');
a.genre := ReadString('Please enter a new genre for this album: ');
end;
// function UpdateAlbums(): albumArray;
// var
// val: Integer;
// i: Integer;
// begin
// WriteLn('<< Album Updater >>');
// val := ReadInteger('Enter an Album''s key number: ');
// if (val = True) then
// WriteLn('Album was found.')
// else
// WriteLn('Album was not found, now returning to Main Menu ');
// end;
procedure DisplayAlbums(albums: albumArray);
var
val: Integer;
begin
repeat
WriteLn('<< Displaying Albums >>');
WriteLn('1. Display all albums');
WriteLn('2. Display genre');
WriteLn('3. Return to main menu');
val := ReadInteger('Enter a number to enter menu: ');
case val of
1: DisplayAlbum(albums);
2: PrintAllGenres(albums);
end;
until val = 3;
end;
procedure Main();
var
albums: albumArray;
val: Integer;
begin
repeat
WriteLn('<< Text Music Player Menu >>');
WriteLn('1. Read in Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album to play');
WriteLn('4. Update an existing Album');
WriteLn('5. Quit');
val := ReadInteger('Enter a number to enter menu: ');
case val of
1: albums := GetAlbums();
2: DisplayAlbums(albums);
3: SelectAlbum(albums);
4: albums := UpdateAlbum(albums);
end;
until val = 5;
end;
begin
Main();
end.
In your code you have written
procedure DisplayAlbum(a: Album);
which means that you need to pass an Album to the procedure, but on line 82 you have written
DisplayAlbum(albums[i].genre);
genre is a field of an Album while you should pass a whole Album
Change line 82 to
DisplayAlbum(albums[i]);
I leave the other errors for you yourself to work out, the errors are very similar, and you should now be able to sort them out.
As I told you yesterday, you may want to (or actually, need to) speak with your tutor to get a better understanding.

display all variables for a specific type

I want to create a menu in WriteFoodMenu that lets the user display all available options (which is currently what the WriteLn does in WriteFoodMenu or only display the options in which the selected venue is located.
So for example if the user selects 'Bakery',
WriteLn(mfood.foodtype, ' - ', mfood.chef, ' - ', mfood.venue);
will only display options in which the venue is a bakery.
Edit: let me know if i need to include anything else
type
Venues =(cafe, resteraunt, bakery, milkbar, fastfood);
Mfood = record
foodtype, chef: string
venue: Venues;
end;
function FoodType(prompt: String): Venues;
var
selection: Integer;
begin
WriteLn('Venues:');
WriteLn(' 1. Cafe');
WriteLn(' 2. Restaurant');
WriteLn(' 3. Bakery');
WriteLn(' 4. Milkbar');
WriteLn(' 5. FastFood');
selection := ReadIntegerRange('Select a venue (1 - 5): ', 1, 5);
result := Venues(selection - 1);
end;
procedure WriteFoodMenu(MFood: MFood);
begin
WriteLn(mfood.foodtype, ' - ', mfood.chef, ' - ', mfood.venue);
end;
You will have to select on Venues:
procedure WriteFoodMenu(Venue: Venues; MFood: MFood);
begin
if MFood.venue = Venue then
WriteLn(mfood.foodtype, ' - ', mfood.chef, ' - ', mfood.venue);
end;
That only works if you pass the desired venue to the procedure. Now you can have a list of MFoods:
const
Foods: array[0..numOfFoods - 1] of MFood =
(
(FoodType: 'Spaghetti'; Chef: 'Luigi'; Venue: resteraunt),
( etc...),
// etc...
( etc...)
);
...
Venue := FoodType('Select a venue');
for I := Low(Foods) to High(Foods) do
WriteFoodMenu(Venue, Foods[I]);
Note that it would make sense to display the prompt you pass to FoodType before you present the menu. You are currently not using the prompt at all.

Why does my program not output all my data?

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.

read() strings of variable length

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.

About SelectNext procedure in Delphi XE2

I'm having the next problem with SELECTNEXT and FINDNEXTCONTROL procedures in Delphi XE2 (Update 4 under WinXP Pro 32b), these procedures aren't working correctly. When a control gets focus and I try to pass to next control with the code below, it does not simply work:
procedure TformMain.cbServicioKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
SelectNext(TWinControl(Sender), True, True);
end;
I've reviewed the code for FINDNEXTCONTROL and I've created a similar procedure and I've detected the problem is in these lines:
function TWinControl.FindNextControl(CurControl: TWinControl;
GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
...........
GetTabOrderList(List);
if List.Count > 0 then
begin
StartIndex := List.IndexOf(CurControl);
...........
end;
For any weird reason, procedure GETTABORDERLIST gives a list with valid references except for the current control focused, it does that LIST.INDEXOF returns -1, and the position in LIST object for current control focused is taken for another object whose NAME property is an empty string.
I developed this code:
procedure TformMain.GoNextControl(T: TWinControl; CheckTabStop: Boolean);
var
vParent, vNextChild : TWinControl;
List : TList;
CurIndex, i : Integer;
S:String;
begin
vParent:= Self; //T.Parent;
vNextChild:= nil;
List:= TList.Create;
try
vParent.GetTabOrderList(List);
if List.Count > 0 then
begin
//CurIndex:= List.IndexOf(T);
CurIndex:= -1;
for i:= 0 to List.Count-1 do begin
S:= TWinControl(List[i]).Name;
if S = EmptyStr then
begin
CurIndex:= i;
Break;
end;
end;
...........................
Anyone has a response for this anomaly or a better solution? Thanks in advance.
d
procedure TfrmMain.ControlKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
SelectNext(ActiveControl, TRUE, TRUE);
Key := #0;
end;
end;

Resources