Pascal Forum RSS Feed (Replies Included)

Only a BEEP in WinCE MC9090

Thu, 09 May 2013 04:22:45 -0700

Hello,
I am developing an application with Lazarus for Windows CE 5.0 (Motorola / Symbol MC9090).
I need you to Realize the MC9090 a BEEP with strong volumen.
With the instruction pascal beep, beep makes very low.
Can help me how to get a very loud BEEP.

thanks

Only a BEEP in WinCE MC9090

Thu, 09 May 2013 04:20:55 -0700

Alternative array access

Sun, 05 May 2013 07:36:10 -0700

Hi,

just wanted to check if anyone knows about an apparently valid, alternate way to access elements of an array:

instead of myArray[x] it is myArray(.x.)

compiles and works just as well, I´ve just never seen it before, nor read anything about it

does anyone have some info where this is explicitly defined?

Thx,

Jack

Re: Code for a multiplication table.

Fri, 03 May 2013 20:14:32 -0700

manipulate it to get what you need...
{ Code for normal multiplication
}
program ass8;
var i,j,store:integer;
const tab=#9;
begin
for i:= 1 to 10 do
begin
for j:= 1 to 10 do
begin
store:= i*j;
write(store,tab);
end;
writeln();
end;
end.

Re: Code for a multiplication table.

Fri, 03 May 2013 20:12:42 -0700

Re: Code for a multiplication table.

Fri, 03 May 2013 20:10:51 -0700

WTS: New release Apple Iphone 5 and Apple Ipad 4 @ Affordable price

Thu, 11 Apr 2013 15:13:33 -0700

We have the brand new Apple iPhone 5(Factory Unlocked) 64,32 and 16GB, Black and White SEALED BOX WORKS ANY SIM

Apple iPhone 5 is the thinnest, Lightest iPhone Ever Features all-New aluminum design, and a stunning 4-Inch Retina Display. An Apple-designed A6 chip for blazing fast performance; and ultrafast wireless technology including LTE and DC-HSDPA - all while delivering even better battery life. The iPhone 5 comes with iOS 6, the world's most advanced mobile operating system...

Package content
1 Apple iPhone 5 Phone
1 Charger
1 Data Cable
1 Handsfree
1 User's GuidePackage content

warranty : 12 months Original warranty

Also Available instock

Apple iPad 3 with Wi-Fi + 4G(16GB,32GB and 64gb)

The Apple iPad 3 WiFi + 4G 64GB is brand new unlocked never used in box directly from manufactuer comes with full accessories and capable of working any where with any network

Specifications General

Product Type : Tablet
Width : 7.3 in
Depth : 0.4 in
Height : 9.5 in
Weight : 21.2 oz

warranty : 12 months Original warranty

Feel Free to contact us:

Sales Manager: Syed Ali

Email: info.sayedali@gmail.com

BB PIN 24/7 CHAT: 2737E5A3

Skype: info.sayedali

Tel: +60136139217

Thanks for your pratonize

Stack overflow

Sat, 06 Apr 2013 05:25:03 -0700

So, i have written recursion which after certain number of calls causes stack overflow. I would like to know if somehow i can avoid this.

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;

Pooh Soro Porject using Dev- Pascal Compiler.

Fri, 05 Apr 2013 13:38:39 -0700

Hello everyone, My class is having team assignments for the Pooh Sorority project. My group got this for in the lines of code which ill post below. The instructions and the .dat file used in this program are in the zip file i attached to the program. First we need to use functions instead of procedures but procedures tend to work and the functions weren't working for us. If someone could help fix up our code and make it work (i hope we are close) to what the instructions say that would be great. Also some of the comments are either old code we were going to use or maybe. and its supposed to print to a printer but it wont let us cause the teacher assigns hw to his students over topics we haven't discussed yet... Anyways I am using the 64 bit version of dev-Pascal compiler so if it can compile in that crappy compiler then it works for me! thanks for any inputs or help is very much appreciated!

program pooh ;

{THIS PROGRAM WILL LOAD THE FILES ON ITS OWN AS LONG AS THEY ARE IN THE DIRECTORY THE APPLICATION IS IN!
}

{
This line causes the runtime error. If you take it out of notes the program will start, get error 2 and close out.
}
{uses
printer;}

const
maxnum = 50;

TYPE
{Memory}
string20 = string[20];
jameshetfield = ARRAY [1..3,1..maxnum] of string20; {I AM THE TABLE!}

VAR

{---------------
Input variables}
poohlist : text ;{The original file being opened}
poohsave : text ;{The new file being save}
poohprint : text; {this prints the file}
how : string;

DataFile : String ;{Asks what the name of the file you want to open is, scrapped}

{-------------------
Processing variables}

firstname : string; {names}
lastname : string; {could be one variable but whatever}

Complex : string; {Complexion}

Height : string; {height}

Trait : string; {trait}
lucker : string; {lucky}
Age : integer; {sage}

lucky : boolean;

directory : string;
readingglasses : char; {reads the characters individually to check for spaces}

{counters}
readcount : integer;
totreadcount : integer;
totlucky : integer;
tot : integer;
counter : integer;
totper : real;
dashcounter : integer;
totletter : integer;

{----------------
Output variables}

poohtable : jameshetfield; {table}

{----------------------------
GET FILE DIRECTORY
----------------------------}
procedure getdirectory;
begin
{gets exact file location AND name}
directory := ParamStr(0);

{Getting how long the string is}
totletter := length(directory);

{Subtractng the file name (pooh.pas) from the directory}
dashcounter := totletter - 8;
delete(directory, dashcounter, 9);

end;

{----------------------------
GET FILE NAME PROCEDURE
----------------------------}

{Getting the filename instead of hardcoding it}
procedure getfile;
begin

assign(poohlist,directory+'\pooh.dat');

assign(poohsave,directory+'\luckyornot.dat');

rewrite(poohsave);
reset(poohlist);
end;

{----------------------------
GET FIRST AND LAST NAME PROCEDURE
----------------------------}
procedure getname;
begin
{clearing variables}
readcount := 0;
totreadcount := 0;
lastname := '';
firstname := '';

{GETTING FIRST NAME}
readingglasses := 'k';
WHILE (readingglasses <> ' ') DO
begin
read(poohlist, readingglasses);

{Seeing if the name is done}
if (readingglasses <> ' ') THEN
begin

{Making sure it's 20 characters}
if readcount <> 20 THEN
begin

{adding each character individually, and counting the characters}
insert(readingglasses,firstname,(readcount + 1));
readcount := readcount + 1;
totreadcount := totreadcount + 1;
end;
end;
end;

{GETTING LAST NAME}
readcount := 0;

readingglasses := 'k';
WHILE (readingglasses <> ' ') DO
begin
read(poohlist, readingglasses);

{Seeing if the name is done}
if (readingglasses <> ' ') THEN
begin

{Making sure it's 20 characters}
IF totreadcount <> 20 THEN
begin

{adding each character individually, and counting the characters}
insert(readingglasses,lastname,(readcount + 1));
readcount := readcount + 1;
totreadcount := totreadcount + 1;
end
end;
end;

end;

{----------------------------
CALCULATING IF LUCKY OR NOT
----------------------------}

procedure islucky;
begin

height := '';
age := 0;
complex := '';
trait := '';

{Reading complex}
readingglasses := 'k';
WHILE (readingglasses <> ' ') DO
begin
read(poohlist, readingglasses);
readcount := readcount + 1;
insert(readingglasses,complex,(readcount));
end ;

{Reading height}
readingglasses := 'k';
WHILE (readingglasses <> ' ') DO
begin
read(poohlist, readingglasses);
readcount := readcount + 1;
insert(readingglasses,height,(readcount));
end;

{Reading trait}
readingglasses := 'k';
WHILE (readingglasses <> ' ') DO
begin
read(poohlist, readingglasses);
readcount := readcount + 1;
insert(readingglasses,trait,(readcount));
end ;

{Reading age}
{WHILE NOT eoln(poohlist) DO
begin }
readln(poohlist, age);
{end ; }

lucky := ((height = 'Tall') AND (trait = 'Handsome') AND (complex <> 'Dark') AND ((Age > 20) AND (Age < 30)))
OR ((((trait = 'Timit') or (height = 'Medium') or (complex <> 'Whitish')) AND ((age < 22) OR (age > 28)))
and NOT ((height = 'small') and (trait = 'Aggressive') and (age > 65))
and not ((trait = 'Timid') AND (trait = 'Tall') and (age < 16)));

totlucky := totlucky + ord(lucky);
end;

{----------------------------
SAVING TO TABLE
----------------------------}
procedure savetojames;
begin
poohtable[1][tot] := firstname;
poohtable[2,tot] := lastname;
if(lucky) THEN
poohtable[3,tot] := 'Lucky'
else
poohtable[3,tot] := 'Unlucky';

end;

{----------------------------
WRITING TO FILE
----------------------------}
procedure writetofile;
begin
{I had to add Flush to make sure it wrote ALL of the words, because it would stop halfway through. I'm not sure if we learned this yet}
counter := 1;
writeln(poohsave,'Pooh Project');
writeln(poohsave,'Group 1');
writeln(poohsave,'CIS 136 30');
writeln(poohsave);
writeln(poohsave,'Last name':10, '|' , 'First name':10, '|', 'Lucky?':10);
writeln(poohsave,'===============================' );
Flush(poohsave);

while counter < tot do
begin
writeln(poohsave,poohtable[1,counter]:10 ,poohtable[2,counter]:10, poohtable[3,counter]:10);
Flush(poohsave);
counter := counter + 1;
end;

totper := totlucky DIV tot;

writeln(poohsave, 'Total lucky: ', totlucky);
writeln(poohsave, 'Total unlucky: ', (totlucky - tot));
writeln(poohsave, 'Total suitors: ', tot);
writeln(poohsave, 'Percentage lucky: ', (100 - totper*10):3:0, '%');
writeln(poohsave, 'Percentage unlucky: ', (totper*10):3:0, '%');
Flush(poohsave);
end;

{----------------------------
WRITING TO SCREEN
----------------------------}
procedure writetoscreen;
begin

writeln('Last name':10, '|' , 'First name':10, '|', 'Lucky?':10);
writeln('===============================');
counter := 1;
while counter < tot do
begin
writeln(poohtable[1,counter]:10 ,poohtable[2,counter]:10, poohtable[3,counter]:10);
counter := counter + 1;
end;
writeln;

writeln('Total lucky: ', totlucky);
writeln('Total ulucky: ', (tot - totlucky));
writeln('Total suitors: ', tot);
writeln('Percentage lucky: ', (100 - totper*10):3:0, '%');
writeln('Percentage unlucky: ', (totper*10):3:0, '%');
end;

{----------------------------
PRINTING
I couldn't finish writing this because I couldn't even be able to load the printer.
----------------------------}

{
procedure writetoprinter;
begin

counter := 1;
writeln(lst,'Pooh Project');
writeln(poohprint,'Group 1');
writeln(poohprint,'CIS 136 30');
writeln(poohprint);
writeln(poohprint,'Last name':10, '|' , 'First name':10, '|', 'Lucky?':10);
writeln(poohprint,'=============================== ');
Flush(poohprint);

while counter < tot do
begin
writeln(poohprint,poohtable[1,counter]:10 ,poohtable[2,counter]:10, poohtable[3,counter]:10);
Flush(poohprint);
counter := counter + 1;
end;

totper := totlucky DIV tot;

writeln(poohprint, 'Total lucky: ', totlucky);
writeln(poohprint, 'Total unlucky: ', (totlucky - tot));
writeln(poohprint, 'Total suitors: ', tot);
writeln(poohprint, 'Percentage lucky: ', (100 - totper*10):3:0, '%');
writeln(poohprint, 'Percentage unlucky: ', (totper*10):3:0, '%');
Flush(poohprint);
close(poohprint);
end;
}
{----------------------------
MAIN PROGRAM
----------------------------}

begin
{assign(lst,'lpt1' ); }
getdirectory;
getfile;

While NOT eof(poohlist) DO
Begin
While NOT eoln(poohlist) DO
begin
tot := tot + 1;
{Processing the data}
getname;
islucky;

{Saving the data}
Savetojames;
end;
end;

{asking how it wants to be presented}
DataFile := 'dfds';
writeln('How do you want to be given the data? Print to screen (types s), write to file (type f), or print on a printer (type p)?)');
while datafile <> 'k' DO
begin
readln(how);

{Screen?}
if how = 's' THEN
begin
writetoscreen;
datafile := 'k';
end

{File?}
else if how = 'f' THEN
begin
write('Written to: ', directory+'\luckyornot.dat');
writetofile;
datafile := 'k';
end

{Printer?}
else if how = 'p' THEN
begin
write('Printed');
datafile := 'k';
{writetoprinter; }
end

{Hello. My name is error}
else
writeln('Could not understand, input should be one of the following: s f p');

end;
readln();
Close(poohsave);
Close(poohlist);
end.

Re: Loop repeating even though got correct guess

Fri, 05 Apr 2013 01:26:46 -0700

   function playgame()  :  Integer ;
   
   var 
      target, gnum,  guess :  Integer ;
      guessed              :  Boolean ;
   
   begin
      gnum     := 0 ;
      target   := Random(2) + 1 ;
      guessed  := false ;
    
      Repeat 
         gnum :=  gnum + 1 ;
         Write('Guess', ' ', gnum, ':') ; 
         
         // gnum :=  gnum + 1 ;
         // Write('Guess', ' ', gnum, ':') ;
         guess := ReadIntegerRange(1, 100) ;
         if guess > target then begin
            WriteLn('The number is smaller then ', guess)
         end
         else if guess < target then begin
            WriteLn('The number is larger then ', guess)
         end
         else begin 
            WriteLn('Well Done .. the number was .. ', guess) ;
            guessed := True
         end
      until (guessed = true) or (gnum >= 7)
   end ;    //until guess = target ;

Loop repeating even though got correct guess

Thu, 04 Apr 2013 04:17:41 -0700

My loop is keep repeating even though i got correct guess how do i solve that ??

Attachment: g.pas (1618 bytes | downloaded 29 times)

help with this program!

Fri, 29 Mar 2013 09:01:07 -0700

hello everyone, I am having problems with this program, I don´t know where is the problem. It´s function is to read a txt. So could yo help me?

this is the program:

program leerarchivo;

const

se='/';

type

  jugadores =(Jugador,CPU1,CPU2,CPU3,CPU4,CPU5);

  estado= (activo,eliminado); // estados de los jugadores en la partida

 mazo= (Biblioteca,Cocina,Comedor,Estudio,Vestibulo,Salon
,
        Invernadero,SalaDeBaile,SalaDeBillar,SenioraBlanco
,
        SenioraCeleste,ProfesorCiruela,SenioritaEscarlata,
CoronelMostaza,
        SeniorVerde,Candelabro,Cuchillo,Cuerda,LlaveIngles
a,Revolver,Tubo);

 lugares= Biblioteca..SalaDeBillar;

 personajes= SenioraBlanco..SeniorVerde;

 armas = Candelabro..Tubo;

 tablero= array [1..5] of array [1..5] of lugares;

 sobre= array [1..3] of mazo;

 manos= array [1..6] of array [jugadores] of mazo;

 listas= array [jugadores] of array [mazo] of boolean; //Lista de sospechosos

 posibles=array [1..9] of lugares;

 arreglo_cartas= array[1..18] of mazo;

 fichaTec=record // Datos de los participantes
  peon : personajes; // peon del jugador
  ubicacion:lugares; // ubicacion del jugador
  estatus: estado; // estado del jugador
  end;

 fichas = array [jugadores] of fichaTec;


var

lugar:tablero;
    Crimen:sobre;
  culpable:personajes;
  arma:armas;
  escena:lugares;
  J1:fichas;
  baraja:mazo;
  mano:manos;
  ultjug:jugadores;
  gameover:boolean;
  lista:listas;
  numjug:integer;
  jugact:jugadores;
  var arreglo:arreglo_cartas;
  ganador:boolean;
  resp:(acusar,sospechar);
  nombreArchivo:string;
  resp2:(guardar,jugar);
  i:mazo;
  contador:integer;
  archivo:text;

  numcartas: array[jugadores] of integer;
  numlistas:array [jugadores] of integer;
  control:integer;
  dum:string;
  temp:array [jugadores] of array [1..21] of mazo;
  afg:integer;
  jugturno:personajes;
  tur:jugadores;

begin

	writeln;
	writeln('lectura de archivo');
	writeln;
	writeln('introduzca el nombre de la partida');
	readln(nombreArchivo);

	assign(archivo,nombreArchivo);
	reset(archivo);

	while not eof (archivo) do begin


		readln(archivo,numjug);

		if numjug=3 then begin

			readln(archivo,crimen[1],crimen[2],crimen[3]);
	
			readln(archivo,j1[jugador].peon,j1[jugador].estatu
s,j1[jugador].ubicacion,numcartas[jugador],numlist
as[jugador]);

			for control:=1 to numcartas[jugador] do read(archivo,mano[control][jugador]);	
			readln(archivo,dum);				
			for control:=1 to numlistas[jugador] do read(archivo,temp[jugador][control]);
			readln(archivo,dum);

			readln(archivo,j1[cpu1].peon,j1[cpu1].estatus,j1[c
pu1].ubicacion,numcartas[cpu1],numlistas[cpu1]);
			if j1[cpu1].estatus=activo then begin
				for control:=1 to numcartas[cpu1] do read(archivo,mano[control][cpu1]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end;
			
			readln(archivo,j1[cpu2].peon,j1[cpu2].estatus,j1[c
pu2].ubicacion,numcartas[cpu2],numlistas[cpu2]);
			if j1[cpu2].estatus=activo then begin
				for control:=1 to numcartas[cpu2] do read(archivo,mano[control][cpu2]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end;

			readln(archivo,jugturno);

			for tur:=jugador to cpu2 do begin
				if j1[tur].peon=jugturno then jugact:=tur;
			end;

			for control:=1 to numlistas[jugador] do lista[jugador][temp[jugador][control]]:=true;
			for control:=1 to numlistas[cpu1] do lista[cpu1][temp[cpu1][control]]:=true;
			for control:=1 to numlistas[cpu2] do lista[cpu2][temp[cpu2][control]]:=true;
		end
		
		else if numjug=4 then begin

			readln(archivo,crimen[1],crimen[2],crimen[3]);
			readln(archivo,j1[jugador].peon,j1[jugador].estatu
s,j1[jugador].ubicacion,numcartas[jugador],numlist
as[jugador]);
			for control:=1 to numcartas[jugador] do read(archivo,mano[control][jugador]);	
			readln(archivo,dum);				
			for control:=1 to numlistas[jugador] do read(archivo,temp[jugador][control]);
			readln(archivo,dum);

			readln(archivo,j1[cpu1].peon,j1[cpu1].estatus,j1[c
pu1].ubicacion,numcartas[cpu1],numlistas[cpu1]);
			if j1[cpu1].estatus=activo then begin
				for control:=1 to numcartas[cpu1] do read(archivo,mano[control][cpu1]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end;

			readln(archivo,j1[cpu2].peon,j1[cpu2].estatus,j1[c
pu2].ubicacion,numcartas[cpu2],numlistas[cpu2]);
			if j1[cpu2].estatus=activo then begin
				for control:=1 to numcartas[cpu2] do read(archivo,mano[control][cpu2]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end;
			
			readln(archivo,j1[cpu3].peon,j1[cpu3].estatus,j1[c
pu3].ubicacion,numcartas[cpu3],numlistas[cpu3]);
			if j1[cpu3].estatus=activo then begin
				for control:=1 to numcartas[cpu3] do read(archivo,mano[control][cpu3]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu3] do read(archivo,temp[cpu3][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu3] do read(archivo,temp[cpu3][control]);
				readln(archivo,dum);
			end;

			readln(archivo,jugturno);

			for tur:=jugador to cpu3 do begin
				if j1[tur].peon=jugturno then jugact:=tur;
			end;

			for control:=1 to numlistas[jugador] do lista[jugador][temp[jugador][control]]:=true;
			for control:=1 to numlistas[cpu1] do lista[cpu1][temp[cpu1][control]]:=true;
			for control:=1 to numlistas[cpu2] do lista[cpu2][temp[cpu2][control]]:=true;
			for control:=1 to numlistas[cpu3] do lista[cpu3][temp[cpu3][control]]:=true;


		end	

		else if numjug=5 then begin

			readln(archivo,crimen[1],crimen[2],crimen[3]);
			
			readln(archivo,crimen[1],crimen[2],crimen[3]);
			readln(archivo,j1[jugador].peon,j1[jugador].estatu
s,j1[jugador].ubicacion,numcartas[jugador],numlist
as[jugador]);
			for control:=1 to numcartas[jugador] do read(archivo,mano[control][jugador]);	
			readln(archivo,dum);				
			for control:=1 to numlistas[jugador] do read(archivo,temp[jugador][control]);
			readln(archivo,dum);

			readln(archivo,j1[cpu1].peon,j1[cpu1].estatus,j1[c
pu1].ubicacion,numcartas[cpu1],numlistas[cpu1]);
			if j1[cpu1].estatus=activo then begin
				for control:=1 to numcartas[cpu1] do read(archivo,mano[control][cpu1]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end;

			readln(archivo,j1[cpu2].peon,j1[cpu2].estatus,j1[c
pu2].ubicacion,numcartas[cpu2],numlistas[cpu2]);
			if j1[cpu2].estatus=activo then begin
				for control:=1 to numcartas[cpu2] do read(archivo,mano[control][cpu2]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end;

			
			readln(archivo,j1[cpu3].peon,j1[cpu3].estatus,j1[c
pu3].ubicacion,numcartas[cpu3],numlistas[cpu3]);
			if j1[cpu3].estatus=activo then begin
				for control:=1 to numcartas[cpu3] do read(archivo,mano[control][cpu3]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu3] do read(archivo,temp[cpu3][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu3] do read(archivo,temp[cpu3][control]);
				readln(archivo,dum);
			end;
			
			readln(archivo,j1[cpu4].peon,j1[cpu4].estatus,j1[c
pu4].ubicacion,numcartas[cpu4],numlistas[cpu4]);
			if j1[cpu4].estatus=activo then begin
				for control:=1 to numcartas[cpu4] do read(archivo,mano[control][cpu4]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu4] do read(archivo,temp[cpu4][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu4] do read(archivo,temp[cpu4][control]);
				readln(archivo,dum);
			end;

			readln(archivo,jugturno);

			for tur:=jugador to cpu4 do begin
				if j1[tur].peon=jugturno then jugact:=tur;
			end;
			
			for control:=1 to numlistas[jugador] do lista[jugador][temp[jugador][control]]:=true;
			for control:=1 to numlistas[cpu1] do lista[cpu1][temp[cpu1][control]]:=true;
			for control:=1 to numlistas[cpu2] do lista[cpu2][temp[cpu2][control]]:=true;
			for control:=1 to numlistas[cpu3] do lista[cpu3][temp[cpu3][control]]:=true;
			for control:=1 to numlistas[cpu4] do lista[cpu3][temp[cpu4][control]]:=true;


		end	

		else if numjug=6 then begin

			readln(archivo,crimen[1],crimen[2],crimen[3]);
	
			readln(archivo,crimen[1],crimen[2],crimen[3]);
			readln(archivo,j1[jugador].peon,j1[jugador].estatu
s,j1[jugador].ubicacion,numcartas[jugador],numlist
as[jugador]);
			for control:=1 to numcartas[jugador] do read(archivo,mano[control][jugador]);	
			readln(archivo,dum);				
			for control:=1 to numlistas[jugador] do read(archivo,temp[jugador][control]);
			readln(archivo,dum);

			readln(archivo,j1[cpu1].peon,j1[cpu1].estatus,j1[c
pu1].ubicacion,numcartas[cpu1],numlistas[cpu1]);
			if j1[cpu1].estatus=activo then begin
				for control:=1 to numcartas[cpu1] do read(archivo,mano[control][cpu1]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu1] do read(archivo,temp[cpu1][control]);
				readln(archivo,dum);
			end;

			readln(archivo,j1[cpu2].peon,j1[cpu2].estatus,j1[c
pu2].ubicacion,numcartas[cpu2],numlistas[cpu2]);
			if j1[cpu2].estatus=activo then begin
				for control:=1 to numcartas[cpu2] do read(archivo,mano[control][cpu2]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu2] do read(archivo,temp[cpu2][control]);
				readln(archivo,dum);
			end;
			
			readln(archivo,j1[cpu3].peon,j1[cpu3].estatus,j1[c
pu3].ubicacion,numcartas[cpu3],numlistas[cpu3]);
			if j1[cpu3].estatus=activo then begin
				for control:=1 to numcartas[cpu3] do read(archivo,mano[control][cpu3]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu3] do read(archivo,temp[cpu3][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu3] do read(archivo,temp[cpu3][control]);
				readln(archivo,dum);
			end;
			
			readln(archivo,j1[cpu4].peon,j1[cpu4].estatus,j1[c
pu4].ubicacion,numcartas[cpu4],numlistas[cpu4]);
			if j1[cpu4].estatus=activo then begin
				for control:=1 to numcartas[cpu4] do read(archivo,mano[control][cpu4]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu4] do read(archivo,temp[cpu4][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu4] do read(archivo,temp[cpu4][control]);
				readln(archivo,dum);
			end;

			readln(archivo,j1[cpu5].peon,j1[cpu5].estatus,j1[c
pu5].ubicacion,numcartas[cpu5],numlistas[cpu5]);
			if j1[cpu5].estatus=activo then begin
				for control:=1 to numcartas[cpu5] do read(archivo,mano[control][cpu5]);	
				readln(archivo,dum);				
				for control:=1 to numlistas[cpu5] do read(archivo,temp[cpu5][control]);
				readln(archivo,dum);
			end
			else begin
				readln(archivo,dum);
				for control:=1 to numlistas[cpu5] do read(archivo,temp[cpu5][control]);
				readln(archivo,dum);
			end;

			readln(archivo,jugturno);
			
			for tur:=jugador to cpu5 do begin
				if j1[tur].peon=jugturno then jugact:=tur;
			end;

			for control:=1 to numlistas[jugador] do lista[jugador][temp[jugador][control]]:=true;
			for control:=1 to numlistas[cpu1] do lista[cpu1][temp[cpu1][control]]:=true;
			for control:=1 to numlistas[cpu2] do lista[cpu2][temp[cpu2][control]]:=true;
			for control:=1 to numlistas[cpu3] do lista[cpu3][temp[cpu3][control]]:=true;
			for control:=1 to numlistas[cpu4] do lista[cpu3][temp[cpu4][control]]:=true;
			for control:=1 to numlistas[cpu5] do lista[cpu5][temp[cpu5][control]]:=true;

		end;	
	end;
	
	close(archivo);

	writeln('hola');
	readln;

end.

And this is the txt:

5
ProfesorCiruela LlaveInglesa Cocina
SenioritaEscarlata activo Cocina 4 14
Estudio SalaDeBaile SenioraBlanco Candelabro
Vestibulo Salon SenioraCeleste Cuchillo SalaDeBillar Biblioteca SeniorVerde Tubo Invernadero SenioritaEscarlata Cuerda Comedor CoronelMostaza Revolver
CoronelMostaza activo Estudio 5 9
Vestibulo Salon SenioraCeleste Cuchillo Comedor
Estudio SalaDeBaile SenioraBlanco Candelabro SalaDeBillar Biblioteca SeniorVerde Tubo CoronelMostaza
SenioraBlanco activo Vestibulo 5 9
SalaDeBillar Biblioteca SeniorVerde Tubo CoronelMostaza
Estudio SalaDeBaile SenioraBlanco Candelabro Vestibulo Salon SenioraCeleste Cuchillo Comedor
SenioraCeleste activo SalaDeBillar 4 9
Invernadero SenioritaEscarlata Cuerda Revolver
Estudio SalaDeBaile SenioraBlanco Candelabro Vestibulo Salon SenioraCeleste Cuchillo Comedor
SeniorVerde eliminado Invernadero 0 14

Vestibulo Salon SenioraCeleste Cuchillo SalaDeBillar Biblioteca SeniorVerde Tubo Invernadero SenioritaEscarlata Cuerda Comedor CoronelMostaza Revolver
CoronelMostaza

recursion (backtracking) problem, knight coverings

Tue, 26 Mar 2013 14:20:59 -0700

hello everyone,
i have problems with this program and i am praying for your help.
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.
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.

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.

recursion (backtracking) problem, knight coverings

Tue, 26 Mar 2013 14:14:27 -0700

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.

Pascal compile problem

Sun, 24 Mar 2013 03:56:32 -0700

Good morning to everyone. I've been searching for two days, and I cannot find a solution for my problem. When I write a program in pascal turbo, I click run and it works perfectly, but when I try to open up the file in an executable (.exe) extension I can't and the computer gives me this error "The version of this file is incompatible with the version of Windows you are using(...)" , I've already changed the properties for every windows( xp, 95, vista etc...) and it doesn't work anyway. Any solution?. I've uploaded the file, please check if it works in your system(https://mega.co.nz/#!CkognDxS!GTywNkA-bmlM5HZfTb5IN25U2xdS9MggL12qSjN4Dig), I didn't upload it here since they do not accept .exe files. Thank you for reading this and for your time. (I'm using windows 7).

Pascal compile problem

Sun, 24 Mar 2013 03:53:16 -0700

Got problem making program

Sat, 23 Mar 2013 05:46:25 -0700

Hi,

I am trying to create the program for like

if c button pressed it changes the random color

and when spacebar pressed it changes to filled circle

they give me the instructions

i m trying to follow that

but i m getting error that command not found

Attachment: New folder.zip (27065 bytes | downloaded 27 times)

Got problem making program

Sat, 23 Mar 2013 05:44:02 -0700

Much Simpler Roman Numeral decoder, and correct

Mon, 18 Mar 2013 04:28:51 -0700

Some of the code used here forgets the exceptions for 900, 90, 40 and 4, you're supposed to use the shortest string which is legal, and you can subtract a value by including up to one value from the next value below. This is why 90 is XC, not LXXXX, but 999 is CMXCIX and not IM because it goes up more than one value (V and X follow I).

function Roman(x:integer):string;
{ Paul Robinson, Viridian Development Corporation, 2013-03-18

if your compiler doesn't include 'result' as a standard
variable for the return value of a function, uncomment
the next line }
{ var result: string }
begin
result := '';
while x >= 1000 do
begin result := result+'m'; x := x - 1000 end;
if x >= 900 then
begin result := result+'cm'; x := x - 900 end;
if x >= 500 then
begin result := result+'d'; x := x - 500 end;
if x >= 400 then
begin result := result+'cd'; x := x - 400 end;
while x >= 100 do
begin result := result+'c'; x := x - 100 end;
if x >= 90 then
begin result := result+'xc'; x := x - 90 end;
if x >= 50 then
begin result := result+'l'; x := x - 50 end;
if x >= 40 then
begin result := result+'xl'; x := x - 40 end;
while x >= 10 do
begin result := result+'x'; x := x - 10 end;
if x >= 9 then
begin result := result+'ix'; x := x - 9 end;
if x >= 5 then
begin result := result+'v'; x := x - 5 end;
if x >= 4 then
begin result := result+'iv'; x := x - 5 end;
while x >= 1 do
begin result := result+'i'; x := x - 1 end;
{if result is not in your compiler for a return value
uncomment the following line }
{ roman := result;}
end;

Re: Pascal programming help

Wed, 13 Mar 2013 21:53:57 -0700

Post your whole code not just screenshots, we'll may be able to point you in the right direction.

Pascal programming help

Wed, 13 Mar 2013 17:32:55 -0700

Hi guys! I'm sure this is the wrong place since it's Pascal but I need immediate help.
I'm supposed to write this program while will accept an unknown number of names of candidates and the total votes that person has recieved. It's a program to do with elections. It basically has to find the Highest number among the numbers inputted and print "The winner is .....!"
I'm not sure I've written my program the correct way, but I keep getting this error. I would appreciate it if anyone could after this for me please.

And this is the error I get.

Pascal programming help

Wed, 13 Mar 2013 17:31:04 -0700

Re: array and diagonal

Tue, 12 Mar 2013 16:03:30 -0700

PLEASE HELP if there is something that you dont understand my email Covergirl.Daina@gmail.com

Attachment: Diogonal matrix 10.rar (10979 bytes | downloaded 25 times)

Re: array and diagonal

Tue, 12 Mar 2013 16:00:59 -0700

Please help

Attachment: Diogonal matrix 10.rar (10979 bytes | downloaded 29 times)

Re: array and diagonal

Tue, 12 Mar 2013 15:59:08 -0700

Please help

Attachment: Diogonal matrix 10.rar (10979 bytes | downloaded 29 times)