I was looking for the definition in Extended Pascal for the ** exponentiation operation. I've been looking for awhile now and can't seem to find it.
i.e 2**3 = 8
In FreePascal it is implemented in the math unit:
operator ** (bas,expo : float) e: float; inline;
begin
e:=power(bas,expo);
end;
operator ** (bas,expo : int64) i: int64; inline;
begin
i:=round(intpower(bas,expo));
end;
function power(base,exponent : float) : float;
begin
if Exponent=0.0 then
result:=1.0
else if (base=0.0) and (exponent>0.0) then
result:=0.0
else if (abs(exponent)<=maxint) and (frac(exponent)=0.0) then
result:=intpower(base,trunc(exponent))
else if base>0.0 then
result:=exp(exponent * ln (base))
else
InvalidArgument;
end;
function intpower(base : float;const exponent : Integer) : float;
var
i : longint;
begin
if (base = 0.0) and (exponent = 0) then
result:=1
else
begin
i:=abs(exponent);
intpower:=1.0;
while i>0 do
begin
while (i and 1)=0 do
begin
i:=i shr 1;
base:=sqr(base);
end;
i:=i-1;
intpower:=intpower*base;
end;
if exponent<0 then
intpower:=1.0/intpower;
end;
end;
Related
I need to get the output of the execution of my script and integrate it into the installer, everything works well, but I need to add a "cancel" button, it will not be difficult to add a button, but during the execution of the timer, the entire installer window is blocked, but I can not minimize to tray and press any button.
function SetTimer(
Wnd: LongWord; IDEvent, Elapse: LongWord; TimerFunc: LongWord): LongWord;
external 'SetTimer#user32.dll stdcall';
function KillTimer(hWnd: LongWord; uIDEvent: LongWord): BOOL;
external 'KillTimer#user32.dll stdcall';
var
ProgressFileName: string;
function BufferToAnsi(const Buffer: string): AnsiString;
var
W: Word;
I: Integer;
begin
SetLength(Result, Length(Buffer) * 2);
for I := 1 to Length(Buffer) do
begin
W := Ord(Buffer[I]);
Result[(I * 2)] := Chr(W shr 8); { high byte }
Result[(I * 2) - 1] := Chr(Byte(W)); { low byte }
end;
end;
procedure UpdateProgress;
var
S: AnsiString;
I, L, Max: Integer;
Buffer: string;
Stream: TFileStream;
Lines: TStringList;
begin
if not FileExists(ProgressFileName) then
begin
Log(Format('Progress file %s does not exist', [ProgressFileName]));
end
else
begin
try
Stream := TFileStream.Create(ProgressFileName, fmOpenRead or fmShareDenyNone);
try
L := Stream.Size;
Max := 100*2014;
if L > Max then
begin
Stream.Position := L - Max;
L := Max;
end;
SetLength(Buffer, (L div 2) + (L mod 2));
Stream.ReadBuffer(Buffer, L);
S := BufferToAnsi(Buffer);
finally
Stream.Free;
end;
except
Log(Format('Failed to read progress from file %s - %s', [
ProgressFileName, GetExceptionMessage]));
end;
end;
if S <> '' then
begin
Log('Progress len = ' + IntToStr(Length(S)));
Lines := TStringList.Create();
Lines.Text := S;
for I := 0 to Lines.Count - 1 do
begin
if I < ProgressListBox.Items.Count then
begin
ProgressListBox.Items[I] := Lines[I];
end
else
begin
ProgressListBox.Items.Add(Lines[I]);
end
end;
ProgressListBox.ItemIndex := ProgressListBox.Items.Count - 1;
ProgressListBox.Selected[ProgressListBox.ItemIndex] := False;
Lines.Free;
end;
ProgressPage.SetProgress(0, 1);
end;
procedure UpdateProgressProc(
H: LongWord; Msg: LongWord; Event: LongWord; Time: LongWord);
begin
UpdateProgress;
end;
procedure RunInstallBatInsideProgress;
var
ResultCode: Integer;
Timer: LongWord;
AppPath: string;
AppError: string;
Command: string;
begin
ProgressPage :=
CreateOutputProgressPage(
'Installing something', 'Please wait until this finishes...');
ProgressPage.Show();
ProgressListBox := TNewListBox.Create(WizardForm);
ProgressListBox.Parent := ProgressPage.Surface;
ProgressListBox.Top := 0;
ProgressListBox.Left := 0;
ProgressListBox.Width := ProgressPage.SurfaceWidth;
ProgressListBox.Height := ProgressPage.SurfaceHeight;
ProgressPage.ProgressBar.Top := -100;
try
Timer := SetTimer(0, 0, 250, CreateCallback(#UpdateProgressProc));
AppPath := ExpandConstant('{app}\installer.py');
ProgressFileName := ExpandConstant('{app}\tmp\installer-progress.log');
Log(Format('Expecting progress in %s', [ProgressFileName]));
Command := Format('""%s" > "%s""', [AppPath, ProgressFileName]);
if not Exec(ExpandConstant('{cmd}'), '/c ' + Command + ExpandConstant(' {app}\PIPE'), '', SW_HIDE, ewWaitUntilTerminated, ResultCode) then
begin
AppError := 'Cannot start app';
end
else
if ResultCode <> 0 then
begin
AppError := Format('App failed with code %d', [ResultCode]);
end;
UpdateProgress;
finally
KillTimer(0, Timer);
ProgressPage.Hide;
DeleteFile(ProgressFileName);
ProgressPage.Free();
end;
if AppError <> '' then
begin
RaiseException(AppError);
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep=ssPostInstall then
begin
RunInstallBatInsideProgress;
end
end;
enter image description here
I want to sum that thing but only use the 'for loop' (no power functions). I've already created a loop that generates powers:
Program powers;
Var
i, n, result : integer;
writeln('enter N'), read(n);
BEGIN
Result := 1;
for i := 1 to n do
begin
Result := Result * n;
end;
writeln('result=',result);
END.
But I neither have any idea on how to make that code generate multiple powers ( this code only generates n^n) nor how to make a loop that sums them together.
It's best to break problems down into smaller problems. In this case, you may wish to have a pow function to handle the exponentiation for you.
Hopefully the pow function is acceptable if it's not a library function.
function pow(n, exp : integer) : integer;
var
i, result : integer;
begin
result := n;
for i := 2 to exp do
result := result * n;
pow := result;
end;
Then the main portion of your program is simpler.
program powers;
var
n, i, sum : integer;
function pow(n, exp : integer) : integer;
var
i, result : integer;
begin
result := n;
for i := 2 to exp do
result := result * n;
pow := result;
end;
begin
sum := 0;
write('enter N:');
readln(n);
for i := 0 to n do
sum := sum + pow(i, i);
writeln('result=', sum);
end.
Now that I finally understand what you're asking, please try this:
Program powers;
Var
i, j, n, p, result : integer;
BEGIN
write('enter N:');
readln(n);
Result := 0;
for i := 1 to n do
begin
p := 1;
for j := 1 to i do
p := p * i;
Result := Result + p;
end;
writeln('result=', result);
END.
I'm having trouble getting the queue in my program to work. Every adjustment I've tried has resulted in an 'ERangeError: Range check error'.
I know this is because the program is trying to access something that doesn't exist, but I cannot figure out how to fix it.
Here is my queue implementation...
node = record //Square on chessboard
x: integer; //Row coordinate
y: integer; //Col coordinate
d: integer; //Distance from starting position
next: ^node;// (for the queue)
end; //node
coord = ^node;//'Coordinates'
queue = record//Queue w/ Linked List
head: coord;
tail: coord;
end; //queue
procedure init(var q: queue);
begin
q.head := nil;
q.tail := nil;
end; //init
function isEmpty(const q: queue): boolean;
begin
isEmpty := (q.head = nil);
end; //isEmpty
procedure push(var q: queue; m, n, o: integer);
var C: coord;
begin
new(C);
C^.x := m;
C^.y := n;
C^.d := o;
if q.head = nil then begin
q.head := C;
q.tail := q.head;
end
else begin
q.tail^.next := C;
q.tail := C;
end;
end; //push
procedure pop(var q: queue; out m: int; out n: int; out o: int);
var C: coord;
begin
m := q.head^.x;
n := q.head^.y;
o := q.head^.d;
C := q.head;
q.head := q.head^.next;
dispose(C);
if q.head = nil then q.tail := nil;
end; //pop
...and here is the main part of the function that is interacting with it.
while not isEmpty(q) do begin
pop(q, row, col, dst);
new(crd2);
crd2^.x := row;
crd2^.y := col;
crd2^.d := dst;
if valid(B, crd2) and not visited[crd2^.x, crd2^.y] then
visited[crd2^.x, crd2^.y] := true; //Mark square as visited
if (crd2^.x = Gl^.x) and (crd2^.y = Gl^.y) then
exit(crd2^.d); //Goal Check
for i := 1 to 8 do begin
crd2^.x := crd2^.x + mvmtX[i];
crd2^.y := crd2^.y + mvmtY[i];
if valid(B, crd2) and not visited[crd2^.x, crd2^.y] then begin
crd2^.d := crd2^.d + 1;
push(q, crd2^.x, crd2^.y, crd2^.d);
end;//if valid(B, crd)...
end;//for i
end;//while not isEmpty(q)
exit(crd^.d);
end;
I thought I had covered the issue by adding enough new(node) calls in the program, but the error still persists. I'm really at a loss and would appreciate any clarity you could offer.
I would email my professor but he is skiing right now and is hard to reach.
Thank you for any advice :)
unit Test;
interface
var number: Integer;
num1, num2: string;
implementation
begin
number:=1;
if number=1 then begin
num+number:='value 1';
end
else if number=2 then begin
num+number:='value 2';
end;
showmessage(num+number,'');
end.
I want to show this result "value 1" if number = 1 and "value 2" if number = 2.
You could use an array, as the numbers are sequential, eg:
unit Test;
interface
var
number: Integer;
num: array[1..2] of string;
implementation
begin
number := 1;
if number = 1 then begin
num[number] := 'value 1';
end
else if number=2 then begin
num[number] := 'value 2';
end;
ShowMessage(num[number]);
end.
use Format
var number: integer;
value: string;
begin
value := format('value %d', [number]);
end;
it will give "Value (n)" as in "value 1" if you put 1 in the variabel
I have this code:
tInteger :
begin
if(jinfo<maxinfo) then
begin
jinfo:=jinfo+1;
lokasi[jinfo]:=ScanStr;
WRITE(ResFile,jinfo:4);
end;
WRITE(ResFile,' ');
WRITE(ResFile,inum);
end;`
BEGIN
ScanStr:='';
REPEAT
ScanStr:=ScanStr+cc;
ReadChar;
UNTIL NOT (cc in ['a'..'z','A'..'Z','0'..'9','_']);
{Test KeyWord}
TampStr:=UpperCase(ScanStr);
i:=1; j:=JmlKeyWord; {index pencarian keyword dalam tabel}
REPEAT
k:=(i+j) DIV 2;
IF TampStr<=KeyWord[k] THEN j:=k-1;
IF TampStr>=KeyWord[k] THEN i:=k+1;
UNTIL i>j;
IF i-j>1 THEN
BEGIN k:=k+ORD(tKurungTutup); Token := KeyToken; END
ELSE
BEGIN Token := tIdentifier;
ScanStr:=COPY(ScanStr,1,10); END;
end;
But the script gives me this error:
error:illegal expression
error:ordinal expression expected
fatal: Syntax Error,: Expected but identifier SCANSTR found
I don't understand this error message. I'm sure this script was right.
The "script" (which isn't a script - it's code) is wrong.
You're inside a case statement:
tInteger :
begin
if(jinfo<maxinfo) then
begin
jinfo:=jinfo+1;
lokasi[jinfo]:=ScanStr;
WRITE(ResFile,jinfo:4);
end;
WRITE(ResFile,' ');
WRITE(ResFile,inum);
end;
The only thing valid after that is either another case branch, an optional else clause, or a final end.
case TheThing of
ThingA:
begin
// Code here
end;
ThingB:
begin
// Code here
end;
else
// Else code here
end;
You have another full begin..end block, which is invalid syntax.
BEGIN
ScanStr:='';
REPEAT
ScanStr:=ScanStr+cc;
ReadChar;
UNTIL NOT (cc in ['a'..'z','A'..'Z','0'..'9','_']);
{Test KeyWord}
TampStr:=UpperCase(ScanStr);
i:=1; j:=JmlKeyWord; {index pencarian keyword dalam tabel}
REPEAT
k:=(i+j) DIV 2;
IF TampStr<=KeyWord[k] THEN j:=k-1;
IF TampStr>=KeyWord[k] THEN i:=k+1;
UNTIL i>j;
IF i-j>1 THEN
BEGIN k:=k+ORD(tKurungTutup); Token := KeyToken; END
ELSE
BEGIN Token := tIdentifier;
ScanStr:=COPY(ScanStr,1,10); END;
end;