It is the almighty 2048 game..

http://gabrielecirulli.github.io/2048/

and we have to do a simpler version in pascal language.

This is the code i've made till now..

program game2048;

uses crt;

const max = 4;

type matriz = array [1..max,1..max] of integer;

var tabla:matriz;

key:char;

procedure random2 (var k:matriz);

var n1,n2:integer;

begin

repeat

randomize;

n1:=random(3)+1;

n2:=random(3)+1

until k[n1,n2]=0;

k[n1,n2]:=2;

end;

procedure cargaMatriz (var s:matriz);

var i,j:integer;

begin

for i:=1 to max do

begin

for j:=1 to max do

begin

s[i,j]:=0;

end;

end;

random2(s);

random2(s);

end;

function check0 (s:matriz):boolean;

var i,j,c:integer;

begin

c:=0;

for i:=1 to max do

begin

for j:= 1 to max do

begin

if s[i,j]=0 then

c:=c+1;

end;

end;

if c=0 then

check0:=false

else

check0:=true;

end;

procedure printM (var s:matriz);

var i,j:integer;

begin

textbackground(lightgray);

textcolor(black);

clrScr;

for i:= 1 to max do

begin

for j:= 1 to max do

begin

if (check0(s)) then

write(s[i,j],' ')

else

write('c*est fini');

end;

writeln;

end;

end;

procedure movr(var s:matriz);

var i,j,k,aux:integer;

begin

for i:= 1 to max do

for j:= max downto 1 do

for K:= j downto 1 do

begin

if ((s[i,j]=0) and (s[i,k]<>0)) then

begin

aux:=s[i,j];

s[i,j]:=s[i,k];

s[i,k]:=aux;

end;

end;

end;

procedure merger(var s:matriz);

var i,j: integer;

begin

for i:=1 to max do

for j:= 2 to max do

if (s[i,j]=s[i,j-1]) then

begin

s[i,j-1]:=s[i,j-1]+s[i,j];

s[i,j]:=0;

end;

end;

procedure movl(var s:matriz);

var i,j,k,aux:integer;

begin

clrScr;

for i:= 1 to max do

for j:= 1 to max do

for K:= j to max do

begin

if ((s[i,j]=0) and (s[i,k]<>0)) then

begin

aux:=s[i,j];

s[i,j]:=s[i,k];

s[i,k]:=aux;

end;

end;

end;

procedure mergel(var s:matriz);

var i,j: integer;

begin

for i:=1 to max do

for j:= 1 to max-1 do

if (s[i,j]=s[i,j+1]) then

begin

s[i,j]:=s[i,j]+s[i,j+1];

s[i,j+1]:=0;

end;

end;

procedure movu(var s:matriz);

var i,j,k,aux:integer;

begin

clrScr;

for i:= 1 to max do

for j:= 1 to max do

for K:= i to max do

begin

if ((s[i,j]=0) and (s[k,j]<>0)) then

begin

aux:=s[i,j];

s[i,j]:=s[k,j];

s[k,j]:=aux;

end;

end;

end;

procedure mergeu(var s:matriz);

var i,j:integer;

begin

for j:= 1 to max do

for i:=1 to max-1 do

if (s[i,j]=s[i+1,j]) then

begin

s[i,j]:=s[i+1,j]+s[i,j];

s[i+1,j]:=0;

end;

end;

procedure movd(var s:matriz);

var i,j,k,aux:integer;

begin

clrScr;

for i:= max downto 1 do

for j:= 1 to max do

for K:= i downto 1 do

begin

if ((s[i,j]=0) and (s[k,j]<>0)) then

begin

aux:=s[i,j];

s[i,j]:=s[k,j];

s[k,j]:=aux;

end;

end;

end;

procedure merged(var s:matriz);

var i,j:integer;

begin

for j:= 1 to max do

for i:= max downto 2 do

if (s[i,j]=s[i-1,j]) then

begin

s[i,j]:=s[i-1,j]+s[i,j];

s[i-1,j]:=0;

end;

end;

begin

cargamatriz(tabla);

printM(tabla);

writeln('Bienvenido, presione Arriba/aBajo/Izquierda/Derecha o Esc');

repeat

key:=readkey;

begin

case key of

'I','i' : begin

mergel(tabla);

movl(tabla);

random2(tabla);

printm(tabla);

end;

'A','a' : begin

mergeu(tabla);

movu(tabla);

random2(tabla);

printm(tabla);

end;

'D','d' : begin

merger(tabla);

movr(tabla);

random2(tabla);

printm(tabla);

end;

'B','b' : begin

merged(tabla);

movd(tabla);

random2(tabla);

printm(tabla);

end;

end;

end;

until key=#27;

readkey;

end.

one of the thing i don't understand is why the 'random2' procedure doesn't seem to work in the general program, even though it works well when i call it from the procedure 'cargarMatriz'.. and also when i execute it the program it work fine for a while, but after a certain point just it stops displaying.. before ending the game..

Well, i'm a fresher so any hints on a more appropriate aproach will be helpfull..

]]>pls send ur reply to:

kosmios_18@yahoo.com

]]>

I'm using the Lazarus IDE v1.2.6 pascal environment on Windows8 and it's working great. I'm able to use my original code and add some nicer string processing functions with the SysUtils extension. I'm pretty certain there's no way to integrate images into the default text display window where the program actually displays it's text...but I'm hoping there's a way to have my code integrate the popup of a graphic friendly window with each new at-bat displaying an image of the pitcher and hitter.

What I'm really hoping to find is a very simple example of some code that accomplishes this...I work much more effectively finding a simple code fragment that I can further modify for my specifics.

Thanks!

Dennis

I'm just learning to code so I might come across as not the brightest bubble but you need to start somewhere to eventually get good at it. So, I have free pascal complier for linux (CentOS if that matters). I've been trying to create some graphic but my program wouldn't compile as 'graph' unit(library) is not being recognized. I've had a look in specification and clearly as the sun it is described therefore there must be one included in a standard compiler (or is it not, and if not how do I check that?).

Thanks for help (any will be really welcomed).

]]>As I mentioned in a different thread I am just starting off with programming. I choose Pascal mainly because it's the first language you are being thought at uni (at least where I live) and secondly in order to overcome my deep, deep aversion to this programming language (long story). The thing I want to ask is - why there are so many versions (apart of obvious, that is - different platforms) and why so many differences. It's really confusing and makes it that much harder to learn when you try something out just to discover that on your version of compiler it just won't work. That is really frustrating. How can I get my head around the problem? Where do I begin?

]]>a tertiary student will be able to receive an educational grant to assist with their tuition and other

expenses. The system should accept specific data on a student and his/her financial situation and then

determine if the student will be able to receive the grant, and how much grant aid will be provided. The

development of the system is to be done on a phased basis with specific requirements for each phase.

Part 1 of the project required you to simulate the processing for a single student to demonstrate your

understanding of the sequence and selection control structures. The requirements for Part 2 are below,

which requires you to demonstrate your understanding of the iteration control structure. Part 2 should

be considered as additional requirements to those which existed for Part 1. In one or two instances, you

may be asked to replace a specific requirement from the previous deliverable with an updated one ¡V

these will be specified.

The management of Universal Ltd. requires the IPO Chart, Pseudocode, Flowchart, Trace Table, and

Pascal code (including sample screenshots of the executable program) for the product as described

below. It will simulate the processing to be done for more than one student. In addition to the

requirements already provided in Part 1, please accomplish the following:

o The program should allow the user to enter any number of student applications. A value

of either XXX (or its lowercase equivalent) for the student name will indicate that no

more records are to be processed. (Note: do not use arrays).

o Previously UL required the program to accept the student¡¦s identification (ID) number.

Given that UL allows for students from various institutions to submit grant applications,

the possibility exists that a student¡¦s ID number could be duplicated in the program. In

anticipation of the processing of multiple students, UL has decided to create its own

unique way of identifying the students, as shown in the example below:

UL1000 ¡V Micky McKenzie

UL1001 ¡V Cherry Blossom

UL1002 ¡V Jamie Jamison

Rather than accept the students¡¦ ID number, you are required to automatically assign a

sequential ID number to a student¡¦s application (as in the example above). This now

becomes the application number. All other inputs, as outlined in Part 1, remain the

same.

2

o UL wants you to ensure that error-checking is done for all inputs of financial data. Recall that a zero value may be entered in the event a particular cost does not apply.

o Instead of the output requirements outlined in Part 1, UL now wants you to display for each valid application:

„X Application number

„X Student Name

„X Total Educational Expenses

„X Amount Paid

„X Shortfall

„X Application Status

o UL would like a menu-driven statistical summary of the information received from the processing of the applications. As soon as the information has been entered for all students, display the menu shown below and prompt the user to enter an option.

A. Ratio of Total Amount Paid to Total Educational Expenses

B. Ratio of Applications Being Considered for Grants to Applications Processed

C. Average Grant Amount Required per Eligible Student

X. Exit

The program should determine the results to display based on the respective menu options. After displaying the information to the user, the system should continue to re-display the menu to allow the user to make another choice until the user selects the option to exit. Thereafter, the program should terminate.

code for the part 1

Program grant_application (input,output);

USES CRT;

Var

id_num:string;

tertiary_institution :string;

gpa: real;

tuition_fee: real;

cost_texts: real;

misc_edu_cost: real;

total_amnt_paid: real;

acc_cost: real;

total_edu_expenses:real;

name: char ;

key:char;

acc_type: char;

Shortfall:real;

BEGIN

writeln('* * *');
writeln('* *

writeln('

writeln('**** ****');

writeln('Press Any Key to Continue');

Readln(key);

writeln('Please enter your ID number');

Readln(id_num);

writeln('Please enter you name');

Readln(name);

writeln('Please enter your GPA');

Readln(gpa);

IF GPA>4.0

Then

Begin

Writeln('Invalid GPA Entered');

End;

IF GPA<0.0

Then

Begin

Writeln('Invalid GPA Entered');

End;

IF GPA<2.7

Then

Begin

Writeln('GPA is less than whats Required for Grant');

End;

```
Writeln('Please enter your tertiary institution');
Readln(tertiary_institution);
Writeln('Please enter your tuition Fee');
Readln(tuition_fee);
Writeln('Please enter your textbooks cost');
Readln(cost_texts);
Writeln('Please enter your miscellaneous cost educational items');
Readln(misc_edu_cost);
Writeln('Please enter your accommodation type');
Readln(acc_type);
Writeln('Please Enter Total Amount Paid');
Readln(total_amnt_paid);
IF (acc_type = 'O') or (acc_type ='o') THEN
BEGIN
acc_cost:=0.15*tuition_fee;
END
ELSE
BEGIN
IF (acc_type = 'N') or (acc_type ='n') THEN
BEGIN
acc_cost:=0.20*tuition_fee;
END
ELSE
BEGIN
IF (acc_type = 'D') or (acc_type ='d') THEN
BEGIN
acc_cost:=0.30*tuition_fee;
END
ELSE
BEGIN
WRITELN('Invalid code of', acc_type );
WRITELN('Please enter O or N or D ')
END;
END;
END;
total_edu_expenses:= tuition_fee + cost_texts + misc_edu_cost + acc_cost;
Shortfall:= total_edu_expenses - total_amnt_paid;
WRITELN ('Students ID Number ',id_num);
WRITELN ('Students Name ',name);
WRITELN ('Tertiary Institution Attending ',tertiary_institution);
WRITELN ('Accommodation Type ',acc_type);
WRITELN ('Total Education Expenses $', total_edu_expenses:1:2);
WRITELN ('Total Amount Paid $', total_amnt_paid:1:2);
WRITELN ('Shortfall Amount $',Shortfall:1:2);
IF total_amnt_paid >= total_edu_expenses
Then
Begin
Writeln(name, ' Your is Application REJECTED');
End;
```

Readln;

while name: == xxx

END

where should part 2 code be written, what should be written?

]]>Thanks in advance.

]]>I have a Pascal source file which I need to compile, you can find code like this in it:

```
type x = array [1:2] of integer;
a = ^b;
b = record u: x;
v : pointer;
w,o : a;
end;
```

The file doesn't compile with fpc, what kind of dialect of Pascal may it be?

Thanks for your help!

]]>Now I want to create a help screen so that the arrow keys will move to the bottom of the screen and when it reaches that point, if there is more text it will scroll up the screen, and if needed one can move back up. Unsure of how to have the top part of the text screen scroll off when it reaches new text past the bottom.

]]>I need to convert my file of text ... looks like 183,50'enter'156,25'enter' and so on ... convert to file of reals because I have to do some counting with those numbers.

This is my code

var invest: text; slovo: string; inv: file of real;

begin

assign(f, 'inv.txt');

reset(f);

rewrite(inv);

while not EOF(f) do

begin

readln(f, slovo);

procedure Val(const slovo:string; var U: real; var Code: Word);

writeln(inv, U);

end;

end.

but it writes me error ... illegal extension.

So any help would be really great.

Thanks

the input ... i want my program to output the price, icecreamcode, sub pls help me.. sorry for bad english.

this is my program

program Icecreams;

uses crt;label

loop;const

HFS = 79;

CCY = 79;

BBS = 69;

MOC = 69;

CLS = 69;

CFS = 69;

HFB = 129;

SCC = 129;

CTR = 129;

FFT = 159;

TPB = 109;

STE = 109;

ORE = 109;

CBN = 109;

TEQ = 399;

CFD = 299;

CE = 15;

FD = 15;

CY = 10;

OO = 10;

CL = 10;

WC = 10;

BB = 10;

HF = 10;

SY = 10;

AD = 10;

FN = 10;

BE = 50;

WE = 50;var

choice : integer;

MENUS,count,choices : string;procedure rule;

begin

clrscr;

gotoxy (16,3);

writeln(' RULE');

writeln;

writeln(' 1. Please use certain letter');

writeln(' EXAMPLE RIGHT IS BBS1 not BbS1');

writeln;

writeln(' 2. Dont input any thing none-coded');

writeln;

textcolor(red+blink);

writeln(' To add more RULE contract Programmer');readln;

end;procedure menucode;

begin

clrscr;

gotoxy (16,3);

writeln(' MENU CODE');

writeln;

writeln(' ICECREAM TOPPING');

writeln;

writeln(' Hot fudge super Sunday 79 bath = HFS Cherrydip 15 bath = CE');

writeln(' Chewy chocky 79 bath = CCY Fandip 15 bath = FD');

writeln(' BlueBerry Sunday 69 bath = BBS Cherry 10 bath = CY');

writeln(' Coffee Sunday 69 bath = CFS Fan 10 bath = FN');

writeln(' Chockcolate Sunday 69 bath = CLS Almond 10 bath = AD');

writeln(' Mocca Chockco 69 bath = MOC Strawberry 10 bath = SY');

writeln(' Hot Fudge Bonanza 129 bath = HFB Hotfudge 10 bath = HF');

writeln(' Super Chockco 129 bath = SCC Blueberry 10 bath = BB');

writeln(' Fongdu For two 159 bath = FFT Whipcream 10 bath = WC');

writeln(' Oreo brownie 109 bath = ORE Brownie 50 bath = BE');

writeln(' Caramel banana 109 bath = CBN Waffle 50 bath = WE');

writeln(' Coit tower 129 bath = CTR Caramel 10 bath = CL');

writeln(' Strawberry stripe 109 bath = STE Oreo 10 bath = OO');

writeln(' Triple blueberry 109 bath = TPB');

writeln(' The eartquake 399 bath = TEQ');

writeln(' Chockcolate Fondu 299 bath = CFD');

readln;

end;procedure mainprogram;

begin

write ('What do you want?');

readln;

end;begin

clrscr;

gotoxy (16,3);

writeln (' SWENSEN MENU CHOOSE');

writeln;

writeln (' ----------------------------------------------');

writeln (' บ Open Manual Press 1 ( For employee ) บ');

writeln (' บ List of Menu Press 2 บ');

writeln (' บ Program Press 3 บ');

writeln (' -----------------------------------------------');

writeln;

write (' Menu Select = ');

readln(choice);

case choice of

1 : rule;

2 : menucode;

3 : mainprogram;

end;

end.

And i'm stuck on the procedure mainprogram... thank you very much!

]]>Program Final;

Uses crt;

Var movement:char;

level, x, y, z, score, rand:Integer;

Track:Array[1..10] of Integer;

Procedure field;

Begin

For z:= 1 to 15 do

Begin

rand:= random(3)-1;

Track[z]:= 20 + rand;

End;

Procedure Playermovement;

Begin

movemnt:=readkey;

case movement of

'j':Begin

gotoxy(x,15);

write('');

x:=x-1;

End;

'k':Begin

gotoxy(x,15);

write('');

x:=x+1;

End;

End;

Procedure layout;

begin

y:=9;

For z:= 1 to 15 do

Begin

y:=y + 1;

gotoxy(track[z, y);

writeln('*');
gotoxy(track[z] + 20, y);
writeln('*');

End;

delay(100);

End;

Procedure Trackmovement;

Begin

For z:=15 downto 2 do

Begin

Track[z]:=Track[z-1];

rand:= random(3)-1;

Track[1]:=20 + rand;

End;

End;

Begin

cursoroff;

level:= 1;

points:= 0;

writeln('Welcome to Podracer 2014!');

readkey;

writeln('Would you like to start a new game? (y/n)');

readln;

writeln('Level: ', level);

delay(100);

track;

layout;

Playermovement;

repeat

Trackmovement;

clrscr;

layout;

gotoxy(25, 40);

score:=score+level;

write('Score: ', score);

level:=level+1;

until 1 = 2;

readkey;

Can anyone help a lowly CompSci student?

]]>`program test;

var

grid_esy:array [0..10,0..10] of integer; //might change togrid_esy:array [0..10,0..10] of integer;

grid_esy_adj:array [0..10,0..10] of integer;

grid_avg:array [1..15,1..15] of integer;

grid_hrd:array [1..20,1..20] of integer;

grid_esy_visual:array [0..10,0..10] of char;

index,counter,grid_esy_column,TypeOfGame,grid_esy_row:integer;

column,row,x,y,turn:integer;

comma:char;

label 1,2,3,4,6,7;

begin

randomize;

writeln('What type of game would you like');

writeln('1.) easy');

writeln('2.) average');

writeln('3.) Hard(ish)');

readln(TypeOfGame);

case TypeOfGame of

1: 1: begin

writeln('Use grid functions to pick your block.');

For grid_esy_row:=1 to 9 do // change values for harder difficulty

begin

For grid_esy_column:=1 to 9 do // change values for hared difficulty

begin

grid_esy[grid_esy_row,grid_esy_column]:=0;

write(grid_esy[grid_esy_row,grid_esy_column]);

end;

writeln;

end;

goto 2;

{----------------------------------grid set-------------------------------------------}

2: for index:=1 to 10 do // change values for harder difficulty

3: begin

row:=0;

column:=0;

row:=random(9)+1;

column:=random(9)+1;

if grid_esy[row,column] = 0

then begin

grid_esy[row,column]:=9; // change values for harder difficulty

writeln(row,column);

writeln(grid_esy[row,column]);

end

else begin

goto 3;

end;

end;

{----------------------------------mines set-------------------------------------------}

```
For row:=1 to 9 do // change values for harder difficulty
begin
For column:=1 to 9 do
begin
If grid_esy[row,column] <> 9
then
begin
If grid_esy[row - 1,column]= 9
then
begin
grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[row + 1,column]= 9
then
begin
grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[row - 1,column - 1]= 9
then
begin
grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[ row + 1,column + 1]= 9
then
begin
grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[row,column + 1]= 9
then
begin
grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[row,column - 1]= 9
then
begin grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[row - 1,column + 1]= 9
then
begin grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
IF grid_esy[row + 1,column - 1]= 9
then
begin grid_esy_adj[row,column]:= 1 + grid_esy_adj[row,column];
end;
end
else
begin
grid_esy_adj[row,column]:=9
end;
end;//end of loop 2
end;//end of loop 1
```

{----------------------------------labeling-------------------------------------------}

counter:=0;

writeln;

```
For row:=1 to 9 do
begin
For column:=1 to 9 do
begin
grid_esy_visual[row,column] := char (254);
end;
writeln;
end;
```

6: For row:=1 to 9 do

begin

For column:=1 to 9 do

begin

write(grid_esy_visual[row,column]);

end;

writeln;

end;

```
Write('Use X and Y coordinates to pick Block you want to target: ');
read(x);
read(comma);
readln(y);
turn:=1 + turn;
If grid_esy_adj[x,y] = 9
then
begin
If turn = 1
then
begin
if grid_esy_adj[x,y] = 9
then
begin
```

7: row:=random(9)+1;

column:=random(9)+1;

grid_esy_adj[x,y]:=0;

for index:=1 to 1 do

begin

if grid_esy_adj[row,column] = 0

then begin

grid_esy_adj[row,column]:=9; // change values for harder difficult

end

else begin

goto 7;

end;

end;

end;

end

else

begin

goto 4;

end;

end

else

begin

If grid_esy_adj[x,y] = 0

then // Rows the Columns Y then X

begin

grid_esy_visual[x,y] := char(255);

repeat

until

goto 6;

end

else

begin

grid_esy_visual[x,y]:=char(grid_esy_adj[x,y] + 48);

goto 6;

end;

```
end;
```

4: writeln('That was a bomb sorry');

turn:=turn - 1;

writeln('You finshed ',turn:0,' turns without hitting a bomb');

{----------------------------------clearing/picking-------------------------------------------}

end;// end of case

```
2: begin
end
3: begin
end
end;
```

end.

`

]]>I've checked the code - everything works, except the part (it's in bold), where the program has to write matching pair of quadrangle side lengths.

program Area;

var x, y, S, n: real;

begin

WriteLn('Enter quadrangle area:');

ReadLn(S);

WriteLn('Enter accuracy:');

ReadLn(n);

x:=n; y:=n;

WriteLn;

WriteLn('Calculating possible lenghts of quadrangle sides...');

While (x*y<>S) and (y<=(S/n)) and (x<=S) do begin
If x+n<=S then
x:=x+n
else begin
x:=n;
y:=y+n;
End;
** If x*y=S then

WriteLn(x:0:2,' ; ', y:0:2);**

End;

WriteLn;

WriteLn('Calculation has been finished.');

ReadLn;

end.

What's wrong there? Could be a compiler bug or something other?

]]>Thanks. ]]>

Thanks for you help. ]]>

Make a program in Pascal that after has read a text with a list of nums., it will return the numb. of the nums that appear less than one times in the text.

The text that will be read from the program should be like that.

In the first line there are two nums. seperated by a space, n and m. N is the number of nums that exist, like if the text contains the numbers 1,2,3,4, n is 4 (1..n).

M is how many lines follow.

Every line has a couple of nums, a,b, (1=<a=<n), (1=<b=<n) (a<>b)

a and b are separated by a space.

The file that the program will make will have written on it a num., that says how many nyms are appeared less than two tims in the text.

All the nums. are Integer.

0=<p=<n

i've made the following program, but it only reads the first line of the text. Anyone that can help me? The deadline is almost ended. Thanks in advance.

My code is the following.

Program thefinalp;

Uses SysUtils;

Var

f:Text;

m,d:Integer;

n:Char;

c:String[1];

a,e:array of integer;

LowArr:Integer;

HighArr:Integer;

ArrayLen:Integer;

i:Integer;

begin

Assign(f,'finalp.txt');

Reset(f);

repeat

Read (f,n);

Write(n);

until (n=' ');

Read(f,c);

Write(c);

while not SeekEoln(f) do

begin

read(f,d);

Write(d);

End;

Readln;

Writeln;

StrToIntDef(n,m);

setlength(a,m);

LowArr:=Low(a);

HighArr:=High(a);

ArrayLen:=Length(a);

setlength(e,m);

LowArr:=Low(e);

HighArr:=High(e);

ArrayLen:=Length(e);

for i:= LowArr to HighArr do

begin

repeat

Read (f,a[i]);

Write(a[i]);

until (n=' ');

Read(f,c);

Write(c);

while not SeekEoln(f) do

begin

read(f,e[i]);

Write(e[i]);

End;

Readln;

Writeln;

End;

Readln;

End.

I've made the code after that, the program is how to put into variables all the nums.

I'm a beginner so if anyone could give me an example, would help a lot.

domes.in domes.out

6 7 2

2 4

4 1

3 5

4 3

1 3

http://postimg.org/image/ep71zfqot/

The file represents stock as it is purchased. Therefore more products may be added to it of different/same sizes and barcodes. Each individual item creates a new record whether it be a new size or barcode for example if you have two products of the same barcode and size it stores them as two records. I need a procedure which sorts the records into ascending order of the barcodes and combines the sizes to one record and marks the others for deletion so that the file is like the one in the image below:

http://postimg.org/image/y8sk6dg1p/

-1 means its marked for deletion

i was told i need to do a nested while loop. However i was unable to get it to work

thank you, all help appreciated.

]]>Thank you. ]]>

```
function findName(s:list): pointer;
var p: pointer;
var b: string;
begin
p := s.head;
readln(b);
while (p <> nil) do
begin
if b = p^.name then
findName:= p;
break
end;
findName:= nil;
end;
```

Hello, I wrote this function to find an element in my linked list and give me pointer to that element so that I can write out it's name and other informations stored there. For some reason this always returns just nil. Any ideas why this doesn't work and / or suggestions how to make this work?

Thanks!

procedure SOLVE (var A : LBOARD; INDEX : integer; var SOLUTION : boolean);

var i : integer;

begin

if SOLUTION = false

then if FULL(A)

then begin

SOLUTION := true;

TextColor(10);

WriteLn('Possible solution found.');

PRINT_CHESSBOARD(A);

end

else if THERE_ARE_POSSIBLE_MOVES(A)

then begin

for i := INDEX downto 1 do

if CAN_BE_MOVED(A, i) and (A[i] = 1)

then begin

MOVE(A, i);

RESET(A, i);

if QUEEN_TO_LEFT(A, i) = 0

then SOLVE(A, QUEEN_TO_RIGHT(A), SOLUTION)

else SOLVE(A, QUEEN_TO_LEFT(A,i), SOLUTION);

end;

end

else begin

TextColor(4);

WriteLn('No possible solution found.');

end;

end;

[/code]

]]>

Recently I was thinking of how useful a prime number finder would be. And Im pretty sure there are millions out there, but I tried to build my own.

. After some struggle (and perhaps, as you'll see, some redundancies) I've came up with my own design. You enter the lower and upper values and the program will give you all the primes between both values. Problem is, it stops after "finding" the number 61. No matter what range I use! Could you please help me out?

]]>

Uses crt;

Var x: byte;

Begin

Repeat

Clrscr;

Writeln('hello world!');

Write('AGAIN?? (enter 1 to do it, 0 to exit)');

Until(x=0)

End.

[/size]

I want to somehow remove the ugly phrase "enter 1...", like letting the user press "esc" to exit or maybe an exit button and that I click with my mouse (I saw games written with pascal, some were really awesome, and they featured an exit button :P)

]]>

so the logic would be:

var

movement:array[1..4] of boolean;

k:char;

repeat

clear/flush keyboard buffer {that's the part i need the code/commands for}

if keypressed=true then

begin

k:=readkey;

if ord(k)=77 {right arrow key} then movement[1]:=true;

end;

if movement[1]=true then x:=x+1;

until keypressed;

can anyone help me out with this? if you know of a better way to get the same result please let me know. thanks

]]>

so the logic would be:

var

movement:array[1..4] of boolean;

k:char;

repeat

clear/flush keyboard buffer {that's the part i need the code/commands for}

if keypressed=true then

begin

k:=readkey;

if ord(k)=77 {right arrow key} then movement[1]:=true;

end;

if movement[1]=true then x:=x+1;

until keypressed;

can anyone help me out with this? if you know of a better way to get the same result please let me know. thanks

sorry that this thread was posted twice but upon submitting the thread the screen kept loading and never showed me that the thread was posted. so i logged out and back in again and tried posting the same thread. that's why thread was posted twice. ]]>

]]>

]]>

1 2 3 4 5 6

7 8 9 10 11 12

13 14 15 16 17 18

19 20 21 22 23 24

25 26 27 28 29 30

31 32 33 34 35 36

so, i need to switch 30 with 7. Any ideas?

]]>

The task is to put given number of knights, on given size chess board, that every square of the board is covered. That is, every square on the board is either occupied by a knight or attacked by a knight. knights can attack each other. the solutions are givven here. [link=http://www.contestcen.com/knight.htm][/link]

i am using recursion. algorithm:

1. choose not occupied square

2. try every knight, which can occupy that square

3. choose another square and so on, till knight max number is reached.

basicly, i try every posibble knight positions.

i wrote program, which is below, but it crashes when i put more than 6 knights, and show nonsense in boards below 6. i know that the problem is in backtracking, when i need to delete a knight. but i dont know how to correct it.

again, praying for your help. Thanks in advance.

[code]program zirgai;

uses crt;

type lenta = array[1..8,1..8] of char;

ejimai = array[1..8] of integer;

var L:lenta;

N,M,Grizti:ejimai;

zirgu_sk,dydis,r:integer;

//******************************//

procedure nulinimas(var L:lenta; d:integer);

var x,y:integer;

begin

for x:=1 to d do

begin

for y:=1 to d do

begin

L[x,y]:='0';

end;

end;

end;

//******************************//

procedure tikrinimas(L:lenta; d:integer; var r:integer);

var x,y:integer;

begin

r:=1;

for x:=1 to d do

begin

for y:=1 to d do

begin

if L[x,y]='0' then begin r:=0; break; end;

end;

if L[x,y]='0' then begin r:=0; break; end;

end;

end;

//******************************//

procedure braizyti(L:lenta; d:integer);

var x1,x2,y1,y2,counter,x,y:integer;

begin

counter:=1;

y1:=1;

y2:=3;

for x:=1 to d do // draws a chess board

begin

x1:=1;

x2:=5;

for y:=1 to d do

begin

window(x1,y1,x2,y2);

if (counter mod 2) = 0 then textbackground(red)

else textbackground(green);

clrscr;

writeln;

writeln(' ',L[x,y]);

counter:=counter+1;

x1:=x1+5;

x2:=x2+5;

end;

y1:=y1+3;

y2:=y2+3;

if (d mod 2) = 0 then counter:=counter+1;

end;

end;

//******************************//

procedure Delioti(zirgas,x,y:integer);

var i,z:integer;

begin

tikrinimas(L,dydis,r);

if r=1 then

begin

writeln('done'); // checks if all sqaures are covered

braizyti(L,dydis);

readln;

exit;

end;

///////////////////////////////////////////////////////////

if (x<>1) and (y<>1) and (zirgas<>0) then

begin

if (x>=1) and (y>=1) and (x<=dydis) and (y<=dydis) then

begin

L[x,y]:='Z'; // puts knight, and marks covered squares

for i:=1 to 8 do

begin

if (x+N[i]>=1) and (y+M[i]>=1) and (x+N[i]<=dydis) and (y+M[i]<=dydis)

and (L[x+N[i],y+M[i]]<>'Z') and (L[x+N[i],y+M[i]]<>'.') then

begin

L[x+N[i],y+M[i]]:='.'; Grizti[i]:=1;

end;

end;

end;

end;

///////////////////////////////////////////////////////////

for x:=1 to dydis do

begin

for y:=1 to dydis do

begin

if (L[x,y]<>'Z') and (L[x,y]<>'.') then break; // finds not occupied square

end;

if (L[x,y]<>'Z') and (L[x,y]<>'.') then break;

end;

if zirgas<=zirgu_sk then

begin

for i:=1 to 8 do // recursion. calls procedure again and again

begin

Delioti(zirgas+1,x+N[i],y+M[i]);

end;

end;

///////////////////////////////////////////////////////////

if (x<>1) and (y<>1) and (zirgas<>0) then

begin

if (x>=1) and (y>=1) and (x<=dydis) and (y<=dydis) then

begin

L[x,y]:='0';

for i:=1 to 8 do

begin

if Grizti[i]=1 then

begin // deletes knight, and his covered squares

L[x+N[i],y+M[i]]:='0';

end;

end;

end;

end;

for z:=1 to 8 do

begin

Grizti[z]:=0;

end;

///////////////////////////////////////////////////////////

end;

//******************************//

begin

N[1]:=1; M[1]:=2;

N[2]:=1; M[2]:=-2;

N[3]:=2; M[3]:=-1;

N[4]:=2; M[4]:=1;

N[5]:=-2; M[5]:=-1;

N[6]:=-2; M[6]:=1;

N[7]:=-1; M[7]:=-2;

N[8]:=-1; M[8]:=2;

for dydis:=1 to 8 do

begin

Grizti[dydis]:=0;

end;

writeln('zirgu skaicius:');

readln(zirgu_sk);

writeln('lentos dydis:');

readln(dydis);

nulinimas(L,dydis); // changes all squares value to '0'

Delioti(0,1,1);

readln;

end.

[/code]

]]>

I already made the tree itself (here it is):

program Isosceles;

Uses Crt;

var num_lines, line:Integer;

procedure printline (num_esp, num_ast:Integer);

const aster='*';

esp=' ';

var counter:Integer;

begin

for counter:=1 to num_esp do

write(esp);

for counter:=1 to num_ast do

write(aster);

writeln

end;

begin (*Main program*)

writeln ('Height of the tree= ');

readln(num_lines);

for line:=1 to num_lines do

printline(num_lines-line,2*line-1);

readln;

end.

But now i am stuck and cant figure out how to make the tree trunk

I <------This part i want it to grow as the tree gets bigger(this part needs to be added at the bottom of the tree).

Help would be much appreciated

ps:I am usig Dev-Pascal 1.9.2.

]]>

When I run the program on my old computer, everything works fine.

Does anyone recognize this problem? Solutions?

Thnx

]]>

I was wondering.. Does anyone know where I can find a tool for converting pure Pascal to P-Code in such a way I'd be able to see the P-Code source? Don't need to run the compiled app, just want to learn more about how Pascal is compiled into P-Code.

Thanks.

PS not sure if it's relevant, but I'm on Mac OSX]]>

I was wondering.. Does anyone know where I can find a tool for converting pure Pascal to P-Code in such a way I'd be able to see the P-Code source? Don't need to run the compiled app, just want to learn more about how Pascal is compiled into P-Code.

Thanks.

PS not sure if it's relevant, but I'm on Mac OSX]]>

type

slog=record

ime:string;

staz:integer;

staz_uro:integer

end;

type

niz=array[1..30] of slog;

var

radnik:niz;

pom:slog;

n,i,j:integer;

procedure razmeni(var p,q:integer);

var pom:integer;

begin

pom:=p;

p:=q;

q:=pom

end;

begin

write('unesi broj radnika:');

readln(n);

writeln('unesi podatke o radnicima:');

for i:=1 to n do

begin

with radnik[i] do

begin

write('Ime '); readln(ime);

write('Ukupan radni staz ');

readln(staz);

write('Staz u radnoj organizaciji ');

readln(staz_uro);

writeln

end

end;

for i:=1 to n-1 do

for j:=i+1 to n do

if radnik[i].staz< radnik[j].staz then

razmeni(radnik[i], radnik[j]);

writeln('Sortirani podaci po ukupnoj duzini radnog staza:');

for i:=1 to n do

with radnik[i] do

begin

writeln('Ime: ',ime);

writeln('Ukupan staz: ',staz);

writeln('Staz u radnoj organizaciji: ',staz_uro);

writeln

end;

writeln;

writeln('Imena radnika sa 10 god radnog staza_uro: ');

for i:=1 to n do

if radnik[i].staz_uro=10 then writeln (radnik[i].ime);

end.

Error 26 type missmatch in this line

razmeni(radnik[i], radnik[j]);

]]>

type

slog=record

ime:string;

staz:integer;

staz_uro:integer

end;

type

niz=array[1..30] of slog;

var

radnik:niz;

pom:slog;

n,i,j:integer;

procedure razmeni(var p,q:integer);

var pom:integer;

begin

pom:=p;

p:=q;

q:=pom

end;

begin

write('unesi broj radnika:');

readln(n);

writeln('unesi podatke o radnicima:');

for i:=1 to n do

begin

with radnik[i] do

begin

write('Ime '); readln(ime);

write('Ukupan radni staz ');

readln(staz);

write('Staz u radnoj organizaciji ');

readln(staz_uro);

writeln

end

end;

for i:=1 to n-1 do

for j:=i+1 to n do

if radnik[i].staz< radnik[j].staz then

razmeni(radnik[i], radnik[j]);

writeln('Sortirani podaci po ukupnoj duzini radnog staza:');

for i:=1 to n do

with radnik[i] do

begin

writeln('Ime: ',ime);

writeln('Ukupan staz: ',staz);

writeln('Staz u radnoj organizaciji: ',staz_uro);

writeln

end;

writeln;

writeln('Imena radnika sa 10 god radnog staza_uro: ');

for i:=1 to n do

if radnik[i].staz_uro=10 then writeln (radnik[i].ime);

end.

Error 26 type missmatch in this line

razmeni(radnik[i], radnik[j]);

]]>