program fibrek;
{$N+,X+}
uses crt,dos;
type btype=array[1..16] of byte;
stype=array[1..16] of string[8];
const copyright:stype=
((' **** '),
(' * * '),
('* ** *'),
('* * *'),
('* ** *'),
(' * * '),
(' **** '),
(' '),
(' '),
(' '),
(' '),
(' '),
(' '),
(' '),
(' '),
(' '));
var IntVec : Procedure;
time:extended;
copyrightbyte:btype;
procedure convertstringtobyte(s:stype;var b:btype);
var m,i,j:byte;
begin
for j:=1 to 16 do
begin
m:=0;
for i:=1 to 8 do
begin
if s[j][i]<>' ' then m:=m or (128 shr (i-1));
end;
b[j]:=m;
end;
end;
procedure initmychars(b:btype);
var p:pointer;
begin
p:=addr(b);
asm
push es
push bp
mov ax, $1100
mov bx,$1000
mov cx,1
mov dx,255
les bp, p
int $10
pop bp
pop es
end;
end;
procedure setoldsatz;assembler;
asm
mov ax,$1114
mov bl,0
int $10
end;
procedure newint08;interrupt;
begin
time:=time+1/18.2;
asm pushf end;
intvec;
end;
function fibrek(n:word):extended;
begin
if n<2 then fibrek:=n else fibrek:=round(fibrek(n-1))+round(fibrek(n-2));
end;
procedure scroll(lastline:boolean);
var i,j,x,y:word;
begin
for i:=1 to 80 do
for j:=5 to 24 do
begin
mem[$B800:(i-1)*2+(j-1)*2*80]:=mem[$B800:(i-1)*2+j*2*80];
if (j<>24) or lastline then mem[$B800:(i-1)*2+j*2*80]:=32;
end;
end;
procedure fallenlassen;
var x,y,j:word;
begin
gotoxy(1,1);
writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
writeln('º Fibonacci rekursiv, by Mosoft',chr(255),' º');
write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
gotoxy(1,5);
end;
var i,y:integer;
fib:extended;
min:longint;
begin
clrscr;
i:=-1;
textcolor(2);
convertstringtobyte(copyright,copyrightbyte);
initmychars(copyrightbyte);
fallenlassen;
{Start der Berechnung}
GetIntVec($8,@IntVec);
y:=4;
repeat
inc(i);
time:=0;
{Zeit stoppen}
SetIntVec($8,@newint08);
fib:=fibrek(i);
setintvec($8,@intvec);
{in min und sek umrechnen}
min:=trunc(time/60);
time:=time-min*60;
{Ausgabe}
inc(y);
if y=26 then
begin
scroll(true);
dec(y);
end;
gotoxy(1,y);
write('Fibonacci von ',i:5,' = ',fib:15,'; Dauer: ',min:4,' Minute(n), ',time:5:2,' Sekunden');
until (keypressed);
while keypressed do readkey;
scroll(true);
scroll(true);
gotoxy(1,y);
write('Von Holger Metzler');
readkey;
setoldsatz;
end.