From ts@uwasa.fi Wed Oct 27 07:00:00 2004
Subject: FAQPAS7.TXT contents
Date: Wed, 27 Oct 2004 07:00:00
From: ts@uwasa.fi (Timo Salmi)

                               Copyright (c) 1993-2004 by Timo Salmi
                                                 All rights reserved

FAQPAS7.TXT The seventh set of frequently (and not so frequently)
asked Turbo Pascal questions with Timo's answers. The items are in
no particular order.

You are free to quote brief passages from this file provided you
clearly indicate the source with a proper acknowledgment.

As to questions. If you wish to have individual Turbo Pascal
consultation, please post your questions to a suitable Usenet
newsgroup like news:comp.lang.pascal.borland. It is much more
efficient than asking me by email. I'd like to help, but I am very
pressed for time. I prefer to pick the questions I answer from the
Usenet news. Thus I can answer publicly at one go if I happen to
have an answer. Besides, newsgroups have a number of readers who
might know a better or an alternative answer. Don't be discouraged,
though, if you get a reply like this from me. I am always glad to
hear from fellow Turbo Pascal users.

If you consider asking me for my TP source codes please do not write
to me. Instead please see http://www.uwasa.fi/~ts/garbo.html#faqtimo

If you are an experienced Turbo Pascal programmer with Turbo Pascal
material you would like to circulate publicly world-wide, you are
welcome to submit your material to the Garbo MS-DOS archives at the
University of Vaasa. To do that you *FIRST* must *CAREFULLY* read
the uploading instructions and the formal requirements in the file
ftp://garbo.uwasa.fi/pc/UPLOAD.TXT. You are also welcome to contact
me by email for these instructions if you are not familiar with
downloading them from the Garbo archives. Also see
 http://www.uwasa.fi/~ts/garbinfo/garb1996.html

More Turbo Pascal information can be found on the net.
See http://www.uwasa.fi/~ts/http/http2.html#pascal for links.

....................................................................
Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi/ archives 193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa
mailto:ts@uwasa.fi <http://www.uwasa.fi/~ts/>  ; FIN-65101,  Finland
Spam foiling in effect.  My email filter autoresponder will return a
required email password to users not yet in the privileges database.

--------------------------------------------------------------------
151) Is there a frequency table for the different notes (C C# D...)?
152) Where is the help for Code in Val(S; var V; var Code: Integer)?
153) How can I test if an integer number is a prime?
154) How can I detect if a drive exists?
155) How can I detect if a drive medium is write protected or not?
156) How do I change my program's cursor from underscore to a block?
--------------------------------------------------------------------

From ts@uwasa.fi Wed Oct 27 07:01:00 2004
Subject: Play it again Sam
Date: Wed, 27 Oct 2004 07:01:00
From: ts@uwasa.fi (Timo Salmi)

151. *****
 Q: Is there a frequency table for the different notes (C C# D...)?

 A: A table is not needed. The following procedure creates the
different notes.
  Uses FDelay, (* See item #124 Crt.delay problem on a fast PC *)
       Crt;
  (* Play one note *)
  procedure PLAYNOTE (note     : string;
                      octave   : integer;
                      duration : integer);
    function Power (number, exponent : real) : real;
      begin Power := Exp(exponent*Ln(number)); end;
  var i, j : integer;
      arg  : word;
  begin
    i := Pos (note, 'c c#d d#e f f#g g#a a#b ');
    if (i=0) or not odd(i) then begin
      writeln ('Playnote: Parameter out of range');
      halt;
    end;
    j := (octave-2)*12 + Round(i/2);
    arg := Trunc (61.74 * Power (Power (2, 1/12), j));
    Sound (arg);
    Delay (duration);
    Nosound;
    Delay (20);
  end;  (* playnote *)

Here is a simple example
  procedure FINALE;
  const notevect = 'c f a c f a c f a c f a';
        d = 70;
  var i : integer;
  begin
    for i := 1 to 12 do begin
      PLAYNOTE (Copy (notevect, 2*(i-1)+1, 2), 4, d);
      Delay (d);
    end;
  end;  (* finale *)

Bob Schor kindly explained the principle of the algorithm used: "The
principle behind Timo's program is that notes follow a geometric
progression -- doubling the frequency gives the same note an octave
higher. There are twelve notes (include sharps/flats) in an octave,
so one can get a "equally-tempered" scale by dividing the octave (a
factor of 2) into twelve geometrically-equal parts. This involves
taking the 12th root of 2, i.e. the number that, when multiplied by
itself once for each note of the scale (i.e. 12 times), gives you
the octave value, 12. Knowing this, knowing the frequency of a
single note (e.g. A = 440), and knowing where the "black notes"
appear on the scale (between A&B, C&D, D&E, F&G, and G&A), you can
produce the scale you require."
--------------------------------------------------------------------

From ts@uwasa.fi Wed Oct 27 07:02:00 2004
Subject: What is Code in Val?
Date: Wed, 27 Oct 2004 07:02:00
From: ts@uwasa.fi (Timo Salmi)

152. *****
 Q: Where is the help for Code in Val(S; var V; var Code: Integer)?
There is no information on this in help(F1).

 A: Yes there is, if you look in the right place. If you just press
F1, you'll get the Edit Window Help which is not what we want here.
There are several options. Alt-H gets you to the Help menu in the
Turbo Pascal IDE. You can then choose Index or go to the Index
directly from the IDE by using Shift-F1. Look for the keyword "Val".
Alternatively, if you already have in your code the keyword "Val",
move the cursor on it and press Ctrl-F1. Either way you'll get the
Turbo Pascal help for Val procedure together with a good example
which well answers the question. For another example, which utilizes
the value of Code to display the location of potential input errors,
see the item #94 about "How can I avoid run-time errors in numeric
input using readln?"
--------------------------------------------------------------------

From ts@uwasa.fi Wed Oct 27 07:03:00 2004
Subject: The prime directive
Date: Wed, 27 Oct 2004 07:03:00
From: ts@uwasa.fi (Timo Salmi)

153. *****
 Q: How can I test if an integer number is a prime?

 A: Here is the source code for a routine:
  function ISPRIMFN (n : longint) : boolean;
  var i : longint;
  begin
    isprimfn := true;
    for i := 2 to Round(Sqrt(n)) do
      if (n mod i) = 0 then begin
        isprimfn := false;
        exit;
      end;
  end;  (* isprimfn *)
This is not the most efficient solution, because the loop rechecks
values which could recursively be eliminated. However, in this FAQ I
have opted for simplicity rather than efficiency.
  Dr. John Stockton suggests adding the following condition to
exclude negative numbers, zero and one.
  if n<2 then begin isprimfn := false ; exit end ;
--------------------------------------------------------------------

From ts@uwasa.fi Wed Oct 27 07:04:00 2004
Subject: Detecting a drive
Date: Wed, 27 Oct 2004 07:04:00
From: ts@uwasa.fi (Timo Salmi)

154. *****
 Q: How can I detect if a drive exists?

 A: The essential solution to this problem was provided by Osmo
Ronkanen. Included below (after testing) with my best compliments.
Furthermore, my MediaPresentFn function returns if the media is
present in the drive.
  Uses Dos;
  {}
  Function ValidDrive(C:char):Boolean;
  var rg:registers;
      FCB_buff:array[0..37] of byte;
      valid:boolean;
      path:string[3];
  Begin
     path:=c+':'+#0;
     rg.ax:=$2900;
     rg.si:=ofs(path[1]);
     rg.ds:=sseg;
     rg.es:=sseg;
     rg.di:=ofs(fcb_buff);
     MsDos(rg);
     Valid:=rg.al<>255;
     if ((upcase(c)='B') and valid) then
         valid:=mem[Seg0040:$10] and (3 shl 6)<>0;
     ValidDrive:=valid;
  End;
  {}
  Function Removable(C:char):Boolean;
  var rg:registers;
  Begin
   if lo(dosversion)>=3 then begin
     rg.ax:=$4408;
     rg.bl:=Ord(upcase(c))-64;
     MsDos(rg);
     Removable:=(rg.flags and fcarry>0) or (rg.ax=0);
   End
   else Removable:=upcase(C)<'C';
  End;
  {}
  function MediaPresentFn (drive : char) : boolean;
  var s : string;
  begin
    GetDir (0, s);           { Get the current directory }
    {$I-}      { Turn off the run-time error termination }
    ChDir (drive + ':\');      { Try to change the drive }
    {$I+}
    mediapresentfn := IOResult = 0;          { Success ? }
    ChDir (s);       { Go back to the original directory }
  end; (* mediapresentfn *)
  {}
  procedure TEST (drive : char);
  var error : integer;
  begin
    writeln (UpCase(drive), ' ValidDrive     ',
             ValidDrive(drive));
    writeln (UpCase(drive), ' Removable      ',
             Removable(drive));
    writeln (UpCase(drive), ' MediaPresentFn ',
             MediaPresentFn(drive));
  end; (* test *)

For the related question "detecting the type of the drive" please
see
  Item #69 "How to detect if a drive is a CD-ROM drive?".
In TSUNTG of ftp://garbo.uwasa.fi/pc/ts/tspa357c.zip
  ISRAMFN  Is a drive a probable ramdisk
  ISUBSTFN Is a drive a substituted drive (MsDos 3.1+)

Another related "quirk" is that most modern PCs only have one
diskette drive. To check you can use the function
  (* Number of diskette drives on the system *)
  function DRIVESFN : byte;
  var regs       : registers;
      devicelist : word;
  begin
    FillChar(regs, SizeOf(regs), 0);
    Intr ($11, regs);
    devicelist := regs.ax;
    if (devicelist and $0001) = 1 then
       drivesfn := ((devicelist shr 6) and $0003) + 1
     else
       drivesfn := 0;
  end;  (* drivesfn *)
Furthermore, in a one-drive PC, you can control the "Insert diskette
for drive B: and press any key when ready" situations by first
finding out which of A/B is currently active by using
  (* The name of the first diskette drive *)
  function FDRIVEFN : char;
  begin
    if DRIVESFN > 1 then
       fdrivefn := 'A'
     else
       begin
         case Mem [$0000 : $0504] of
           0 : fdrivefn := 'A';
           1 : fdrivefn := 'B'
         end; {case}
       end; {if}
  end;  (* fdrivefn *)
For example, in testing you could use
    if FDRIVEFN = 'A' then TEST ('A');
    if (DRIVESFN = 2) or (FDRIVEFN = 'B') then TEST ('B');

There can be "exotic" devices and drivers where the detection does
not work all the way. For example Dr. John Stockton reported
information on some special devices where the "removability" is not
clear-cut.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Oct 27 07:05:00 2004
Subject: Write protected?
Date: Wed, 27 Oct 2004 07:05:00
From: ts@uwasa.fi (Timo Salmi)

155. *****
 Q: How can I detect if a drive medium is write protected or not?

 A: You can do that by trying to create a new file on the drive. The
code is straight-forward:
  function WRITPRFN (drive : char) : boolean;
  const filename = 'writprfn.tmp';
  var f : file;
      error : boolean;
  begin
    Assign (f, drive + ':\' + filename);
    {$I-} Rewrite (f); {$I+}
    error := IOResult <> 0;
    writprfn := error;
    if not error then begin
      Close(f);
      erase(f);
    end;
  end;
First, however, you can test if the drive exists and if the media is
present. These are covered by "ValidDrive" and "MediaPresentFn"
given in the (previous) item #154 "How can I detect if a drive
exists?". Also, if you wish to be paranoid, you would first
test that the file "writprfn.tmp" does not already exist. See the
item #47 "How can I test whether a file exists?".
   If the function returns false the disc is write-enabled, but if
it returns true there is a very small chance that the write test
failed for other reasons such as the disk being full or the root
directory being out of entries. For an accurate function one could
read an absolute disk section and try to write it back at the same
location. This is a bit more radical option than what I wish to
cover in the FAQ.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Oct 27 07:06:00 2004
Subject: Block cursor?
Date: Wed, 27 Oct 2004 07:06:00
From: ts@uwasa.fi (Timo Salmi)

156. *****
 Q: How do I change my program's cursor from underscore to a block?

 A: Basically the cursor size is governed by the following service
  (* Simple set the cursor size *)
  procedure CURSET (start, bottom : byte);
  var regs : registers;
  begin
    regs.ax := $0100;   (* Service $01 *)
    regs.ch := start;
    regs.cl := bottom;
    Intr ($10, regs);   (* ROM BIOS video driver interrupt *)
  end;  (* csetsize *)
Practically, that is all that is needed. However, just as an
interesting exercise we can look into the service definition a bit
closer. The bitfields for cursor start and options actually is
defined as
  Bit 7    = always set 0
  Bits 6,5 = cursor blink
             0=normal, else invisible
  Bits 4-0 = top scan line of the cursor
Likewise the bottom scan line is defined by the bits 4-0. If you
wish to play with these facts you could write
  uses Dos;
  {}
  (* Set the cursor size *)
  procedure CSETSIZE (start, bottom, blink : byte);
  var regs : registers;
  begin
    regs.ax := $0100;   (* Service $01 *)
    { Cursor start and options }
    regs.ch := (start and 31) or ((blink and 3) shl 5);
    { Bottom scan line (bits 0-4) }
    regs.cl := bottom and 31;
    Intr ($10, regs);   (* ROM BIOS video driver interrupt *)
  end;  (* csetsize *)
  {}
  (* Get the current cursor size *)
  procedure CGETSIZE (var start, bottom : byte);
  var regs : registers;
  begin
    regs.ah := $03;    (* Service $03 *)
    regs.bh := $00;    (* page 1 *)
    Intr ($10, regs);  (* ROM BIOS video driver interrupt *)
    start := regs.ch;
    bottom := regs.cl;
  end;  (* cgetsize *)
  {}
  procedure TEST;
  var StoreBottom, StoreStart : byte;
  begin
    CGETSIZE (StoreBottom, StoreStart);
    CSETSIZE ($00, $07, 0);
    write ('Press any key ');
    readln;
    CSETSIZE ($06, $09, 1);
    write ('Press any key ');
    readln;
    CSETSIZE (StoreBottom, StoreStart, (StoreStart and 96) shr 5);
  end;  (* test *)
  {}
  begin
    TEST;
    readln;
  end.
To understand the above, recall that a byte bit field locations are
defined by [76543210]. The decimal 31 is '00011111' in binary. The
"start and 31" sets the bits 4-0. The blink attribute is located at
[.65.....]. The "blink and 3" sees to it that only two bits are set
and the shl operator in "((blink and 3) shl 5)" shifts the bits left
to the appropriate location in the attribute byte. As for the
"(StoreStart and 96) shr 5" you can practice your understanding of
bit operations by figuring it out in a corresponding manner.
   Additional information from Pedt Scragg. "The scan lines used for
the cursor start at 0 for the top line of the displayed cursor. The
bottom line depends on whether you have a colour capable video card
or a MONO video card. The bottom scan line on a colour capable video
card is 7 and that of a MONO card is 13. For example, a full block
cursor on a colour display would be CURSET(0,7) and for a MONO
display it would be CURSET(0,13)."
   Additional information from Dr. John Stockton, somewhat edited.
"It is not the program's cursor but the system's cursor; in other
words the setting remains after the program stops. Normally, a
program that changes the cursor should restore it." For more on
Text-Mode Cursor http://www.merlyn.demon.co.uk/pascal.htm#Cursor
"It may be best just to observe that the exact effects of a call may
depend not only on CH & CL, but also on the system and mode."
--------------------------------------------------------------------

