Category : Pascal Source Code
Archive   : FUTILS.ZIP
Filename : FTPUDEMO.PAS

program Fast_Units_Demonstration;
uses dos,crt,fswap,fstack,fbios,fwrite,xwin,file1;
var xx : array[1..10] of longint;
charre : char;
orig : Vram_ScrBuf;
csx,csy : byte;

function timenow : longint;
var a,b,c,d : word;
begin
gettime(a,b,c,d);
timenow := (((((a*60)+b)*60)+c)*100)+d;
end;

procedure dbkp;
var a : word;
begin
while biostestkey(a) do a := biosreadkey;
repeat until biostestkey(a);
while biostestkey(a) do a := biosreadkey;
end;

procedure introduction;
begin
settextattr(7);
clrscr;
writeln('You are about to see a demonstration of some of the fastest');
writeln('utilities written for Turbo Pascal.');
writeln;
writeln('If you are not using a CGA or monochrome monitor, you may need');
writeln('to fiddle with the source code to get the writing routines to');
writeln('work. If you have an EGA or VGA or Herculese or "snowy" CGA, you');
writeln('should skip the FWRITE/XWIN demonstration when asked.');
writeln;
writeln;
writeln('But now, let us proceed with the demonstration.');
writeln('Press any key to continue...'); dbkp;
end;

procedure fswapdemo;
var a,b : byte;
c,d : word;
e,f : string;
r : real;
begin
a := 2; b := 87;
e := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
f := '1234567890!@#$%^&*()-=_+[]{};'+#39+'`:"~,./<>?\|';
clrscr;
writeln('First, a demonstration of FSWAP.');
writeln;
writeln('We will start out with two variables, A and B. They are both');
writeln('bytes. A = ',a,' and B = ',b);
writeln('Now we'#39'll run qswapb(A,B) and we have');
qswapb(a,b);
writeln('A = ',a,' and B = ',b);
writeln;
writeln('That was too fast to see, of course.');
writeln('Well, we'#39'll do it 10,000 times in a row.');
writeln('Press any key to start...'); dbkp;
xx[1] := timenow;
for c := 1 to 10000 do qswapb(a,b);
xx[2] := timenow;
r := (xx[2] - xx[1]) / 100;
writeln('That wasn'#39't very long. It only took ',r:4:2,' seconds.');
writeln;
writeln('FSWAP can also swap words using qswapw.');
writeln('But the best one is qswapv. It can swap any two variables of the');
writeln('same length. Let'#39's swap two strings 1000 times.');
writeln('The first string is ',e);
writeln('The second string is ',f);
writeln('Press any key to start...'); dbkp;
xx[1] := timenow;
for c := 1 to 1000 do qswapv(e,f,length(e));
xx[2] := timenow;
r := (xx[2] - xx[1]) / 100;
writeln('That took ',r:4:2,' seconds to swap strings ',length(e),' chars long');
writeln;
writeln;
writeln('Now, on to the next unit.');
writeln('Press any key to continue...'); dbkp;
end;

procedure fstackdemo;
var a : array[1..20] of byte;
c,d,e : word;
st : string;
label InvalidEnter;
begin
clrscr; initwstack(a,sizeof(a));
writeln('FSTACK');
writeln('Let'#39's try some simple stack routines first. First we'#39'll');
writeln('Just push the numbers from 1 to 5 onto the word stack.');
for c := 1 to 5 do pushw(c);
writeln('Okay. Now we'#39'll pop them off again until the stack is empty.');
writeln('And while were at it, we can write them out. Press any key to pop.');
dbkp;
repeat write(popw,' '); until wstackempty;
writeln;
writeln;
writeln('Now we can try something a bit harder. We'#39'll give the byte');
writeln('stack and the word stack the same buffer.');
writeln;
write('Now let me think what to do with that ');
for c := 1 to (random(4)+3) do
begin
delay(500);
write('. ');
delay(500);
end;
writeln;
writeln('Okay. We'#39'll push six words and pop off the twelve bytes that');
writeln('that makes. I'#39'll let you enter the values.');
for c := 1 to 6 do
begin
InvalidEnter: write('Enter number #',c,':');
readln(st);
val(st,d,e);
if e <> 0 then goto InvalidEnter;
pushw(d);
end;
writeln;
writeln('Now that'#39's done. Now we have to initialize the byte stack');
writeln('over the word stack and set the byte size to twice the word size');
writeln('(words are twice as big, after all.).');
initbstack(a,sizeof(a)); setbstack(wstacksize*2);
writeln('Okay. Press any key to do the popping.'); dbkp;
repeat
write(popb,' ');
if bstacksize = 6 then writeln;
until bstackempty;
writeln;
writeln;
writeln('Note that the bytes are popped off in reverse of how the words');
writeln('were pushed on. (That'#39's how stacks work.)');
writeln('The stack is still the same as it was before. If we');
writeln('wanted, we could do all that popping again.');
writeln('Only pushing actually changes the stack itself.');
writeln;
writeln('By the way, all that was done in an array[1..20] of byte.');
writeln;
writeln('You can also switch stacks and save them. The byte and word');
writeln('stacks don'#39't have to be on the same array. Just if you');
writeln('want. You can use value typecasing if you want to push');
writeln('shortints, chars, or integers. You'#39'll have to push longer');
writeln('things in pieces.');
writeln;
writeln('Just a note. You don'#39't have to use arrays. You can use strings');
writeln('records, arrays, sets, or even longints for your stack.');
writeln;
writeln('Now on to FBIOS...');
writeln('Press any key to continue...'); dbkp;
end;

procedure fbiosdemo;
var a,b,c,d : word;
e,f,g,h : byte;
ch : char;
label NoPrint;
begin
clrscr;
biosgetcur(e,f);
writeln('FBIOS');
writeln('Right now, your cursor starts on line ',e,' and ends on line ',f);
writeln('Let'#39's change it.');
if e = 0 then
begin
if vid_mem_start = $B000 then
begin
g := 12; h := 13;
bioscurshape(g,h);
end
else
begin
g := 6; h := 7;
bioscurshape(g,h);
end;
writeln('Now the cursor is an underline.');
writeln('Press any key to continue the demo...'); dbkp;
end
else
begin
if vid_mem_start = $B000 then
begin
g := 0; h := 13;
bioscurshape(g,h);
end
else
begin
g := 0; h := 7;
bioscurshape(g,h);
end;
writeln('Now the cursor is a block.');
writeln('Press any key to continue the demo...'); dbkp;
end;
writeln('But I don'#39't want to do any damage to your cursor, so');
writeln('I'#39'll nicely set it back to what it was before.');
bioscurshape(e,f);
writeln('Press any key to continue the demo...'); dbkp;
writeln;
writeln('We still have printing left to do. When you have your printer');
writeln('ready to print, press any key. If you don'#39't have a printer');
writeln('or you don'#39't want to do any printing, press ESC.');
if keypressed then repeat ch := readkey until not keypressed;
repeat until keypressed;
repeat
ch := readkey;
if ch = #27 then goto NoPrint;
until not keypressed;
writeln('Okay. Now I'#39'm going to print the screen. Here we go...');
biosprintscr;
clrscr;
writeln('There. That works just like a Shift-PrtSc does.');
writeln('FBIOS also has routines to send data to the printer one');
writeln('character at a time, which speeds up graphics printing.');
writeln('Press any key to continue the demo...'); dbkp;
NoPrint: writeln;
writeln('Now what character is at 1,1 on the screen?');
writeln('Hmmm...');
writeln('There'#39's a FBIOS routine for that too.');
writeln('First we have to put the cursor there. Then we'#39'll read the');
writeln('character.'); biosgetxy(e,f);
biosgotoxy(1,1); biosgetchar(ch,g);
biosgotoxy(e,f);
writeln('We did that. By the way, I also used BiosGetXY and BiosGotoXY to');
writeln('go to 1,1 on the screen and return to here.');
writeln('What character did we get?');
writeln('Here it is, on the next line.');
bioschar(ch,g); writeln;
writeln('Press any key to continue the demo...'); dbkp;
clrscr;
writeln('That'#39's not everything. But that'#39's enough for now.');
writeln;
writeln('By the way, all of the "Press any key to continue" or similar');
writeln('wait-for-a-key things are using BiosTestKey and BiosReadKey.');
writeln;
writeln('Press any key to continue...'); dbkp;
end;

procedure fwritedemo;
var scrn : ^vram_scrbuf;
a,b,c,d,e : byte;
ch : char;
r : real;
begin
clrvram(112); settextattr(7); gotoxy(1,1);
writeln('FWRITE');
writeln('I just want to let you know that the text in this demo');
writeln('is still being written with WriteLn.');
writeln;
writeln('This window was cleared using a FWRITE procedure.');
writeln;
writeln('How long does it take to write 2000 characters in random locations');
writeln('on the screen using write?');
writeln;
writeln('Press any key to continue...'); dbkp;
xx[1] := timenow;
for a := 1 to 20 do
begin
for b := 1 to 100 do
begin
ch := chr(random(240) + 16);
c := random(24)+1;
d := random(79)+1;
gotoxy(d,c);
write(ch);
end;
end;
xx[2] := timenow;
xx[3] := xx[2] - xx[1];
r := xx[3] / 100;
gotoxy(1,1); settextattr(112);
writeln('That was write. It took ',r:4:2,' seconds.');
writeln('Now we'#39'll use routines from FBIOS.');
writeln;
writeln('Press any key to continue...'); dbkp;
xx[1] := timenow;
for a := 1 to 20 do
begin
for b := 1 to 100 do
begin
ch := chr(random(240)+16); c := random(24)+1;
d := random(79)+1; biosgotoxy(d,c); bioschar(ch,7);
end;
end;
xx[2] := timenow; xx[4] := xx[2] - xx[1]; r := xx[4] / 100;
gotoxy(1,1); settextattr(112);
writeln('That was BiosChar. It took ',r:4:2,' seconds.');
writeln('Now it is FWRITE'#39's turn with VramCh.');
writeln; writeln('Press any key to continue...'); dbkp;
xx[1] := timenow;
for a := 1 to 20 do for b := 1 to 100 do
begin
ch := chr(random(240)+16); c := random(24)+1; d := random(79)+1;
vramch(d,c,ch,7);
end;
xx[2] := timenow; xx[5] := xx[2] - xx[1]; r := xx[5] / 100;
gotoxy(1,1); settextattr(112);
writeln('That was VramCh. And it took only ',r:4:2,' seconds.');
writeln('Oops! I forgot; the routines that create the random locations');
writeln('take some time themselves. How can I fix that?');
writeln;
writeln('I guess I run the random routines by themselves and subtract');
writeln('that time from the Write, BiosChar, and VramCh'#39's time.');
writeln('It will just take a second to run the randoms. Press any key.'); dbkp;
xx[1] := timenow;
for a := 1 to 20 do for b := 1 to 100 do
begin
ch := chr(random(240)+16); c := random(24)+1; d := random(79)+1;
end;
xx[2] := timenow;
xx[6] := xx[2] - xx[1]; xx[3] := xx[3] - xx[6];
xx[4] := xx[4] - xx[6]; xx[5] := xx[5] - xx[6];
writeln;
writeln('Now we'#39've got the real times.');
r := xx[3] / 100;
writeln(' Write ...... ',r:4:2); r := xx[4] / 100;
writeln(' BiosChar ... ',r:4:2); r := xx[5] / 100;
writeln(' VramCh ..... ',r:4:2);
writeln;
writeln('Press any key to continue this demo...'); dbkp;
clrvram(7); settextattr(7); gotoxy(1,1);
writeln('Okay. When this program started running, it saved the');
writeln('original screen. Let'#39's take a peek at it.');
writeln('Press any key to see the screen, and press any key to return.');
dbkp; new(scrn);
getxy(a,b); getvramsec(scrn^,1,1,80,25,1,1);
putvramsec(orig,1,1,80,25,1,1); gotoxy(csx,csy); dbkp;
putvramsec(scrn^,1,1,80,25,1,1);
gotoxy(a,b);
dispose(scrn);
writeln('Now we'#39're back. When you leave this demo, the screen will be');
writeln('restored.');
writeln;
writeln('You can use FWRITE'#39's routines to switch the I/O done from the');
writeln('screen to a large enough buffer.');
writeln;
writeln('FWRITE'#39's routines include procedures and functions that:');
writeln(' Copy one place on the screen to another');
writeln(' Repeat a character a given number of times');
writeln(' Write out strings');
writeln(' Scroll the screen up or down');
writeln(' Get characters, lines, or whole sections of the screen');
writeln('And others!');
writeln;
writeln('Press any key to continue...'); dbkp;
end;

procedure xwindemo;
var singl,doubl,trpl : string;
begin
settextattr(7); clrscr; singl := bordermaker(218,191,192,217,196,179);
doubl := bordermaker(201,187,200,188,205,186);
trpl := bordermaker(3,4,5,6,29,18);
writeln('Windows are fun. Let'#39's make one now and do our writing in');
writeln('that.');
writeln('Press any key to create the window...'); dbkp;
createwindow(1,5,3,75,22,7,112,'The first window','/\\/-!');
writeln('Press any key to continue this demo...'); dbkp;
writeln;
writeln('This window is a XWIN window. It uses Turbo Pascal'#39's');
writeln('Window procedure so that writeln will work in it. It doesn'#39't');
writeln('affect any BIOS routines or FWRITE. It is best not to use');
writeln('TP'#39's Window procedure if you use XWIN.');
writeln;
writeln('XWIN is very fast. Press any key to create four windows...'); dbkp;
createwindow(2,1,1,60,15,7,7,'Window #1',singl);
writeln('Press any key for next...'); dbkp;
createwindow(3,21,1,80,15,7,112,'Window #2',doubl);
writeln('Press any key for next...'); dbkp;
createwindow(4,1,11,60,25,112,7,'Window #3','/\\/-|');
writeln('Press any key for next...'); dbkp;
createwindow(5,21,11,80,25,112,112,'Window #4',trpl);
writeln('Now we have four windows. We can call any one we want.');
writeln('But now, we'#39'll call the big window back again.');
writeln('Press any key to get the big window...'); dbkp;
gotowindow(1);
writeln;
writeln('Now we'#39'll call each little window.');
writeln('Press any key to call the windows...'); dbkp;
gotowindow(5);
gotowindow(4);
gotowindow(3);
gotowindow(2);
writeln;
writeln('That'#39's enough for this demo.');
writeln('Press any key to pop the windows and go on to FILE1...');
dbkp; popwindow; popwindow; popwindow; popwindow; popwindow;
window(1,1,80,25);
end;

procedure file1demo;
var b : boolean;
fname : pathstr;
r : byte;
begin
fname := 'READ.ME';
settextattr(7); clrscr;
writeln('Is READ.ME here?');
b := existfile('READ.ME');
if b = false then
begin
writeln('Well, I couldn'#39't find READ.ME.');
write('Enter the name and path of the file you would like typed:');
readln(fname);
b := existfile(fname);
end;
if b = false then
begin
writeln('Oh dear. The file you entered wasn'#39't there as you entered it,');
writeln('And neither was READ.ME.');
writeln;
end
else
begin
writeln('Press any key to stop the typing, or ESC to end.');
writeln('The typing will be in reverse video.');
settextattr(112);
typefile(fname,r);
settextattr(7);
if r <> 0 then writeln('Oops! There was an error in typing!')
else
begin
writeln;
writeln('Okay, we'#39're done.');
end;
writeln('Press any key to continue...'); dbkp;
end;
writeln;
writeln('Well, that'#39's the end of this demo.');
writeln;
writeln('If you haven'#39't already, be sure to read READ.ME');
writeln('at least a bit carefully.');
writeln;
writeln('But now, it'#39's time to go.');
writeln('Press any key to end...'); dbkp;
end;


begin
getxy(csx,csy);
getvramsec(orig,1,1,80,25,1,1);
randomize;
introduction;
fswapdemo;
fstackdemo;
fbiosdemo;
clrscr;
write('Do you want to do the FWRITE and XWIN demonstration? (Y/N) ');
repeat
charre := readkey;
charre := upcase(charre);
until (charre in ['N','Y']);
if charre <> 'N' then
begin
fwritedemo;
xwindemo;
end;
file1demo;
putvramsec(orig,1,1,80,25,1,1); gotoxy(csx,csy);
end.