cncst3@unix.cis.pitt.edu (Chunqing N. Cheng) (10/29/90)
In article <2280@oucsace.cs.OHIOU.EDU> tswingle@oucsace.cs.ohiou.edu (Tom Swingle) writes: >Does anybody know of a way to *accurately* time an event down to at least 1/100 >of a second in Turbo Pascal? I have tried using the GetTime procedure, but it >relies on DOS, which is only accurate to about 5/100 of a second. Turbo Pascal >has the Delay procedure which can accurately time to 1/1000 of a second. Does >anybody know how they do this? > >Here is what I would like to do. I would like to create a little unit called >Timer which would have procedures for timing how long a block takes to execute >regardless of the speed of the machine it is working on. It would work >something like this: > >uses Timer; > >var t:word; > >begin > MarkTime; { Start counting now } > > . . . . . . . > > t:=TimeElapsed; { Check how much time elapsed in 1/100 seconds } >end. > >This way, you could make a block take the same amount of time to execute on any >machine, regardless of that machine's speed by just looping until TimeElapsed >had reached the time you wanted it to. But I found that it has to be accurate >to at least 1/100 of a second to be useful. If anyone can help me it would be >greatly appreciated. (Either E-mail or a follow-up post is fine) The following are four files 1. Demo.pas 2. music.pas 3. jingle.mus 4. 123.mus Demo file shows you how to do timing upto 1/100 sec or even smaller. music.pas is the unit file and the other two are data file for background music. If it proves to be more useful, would someone please put this file to a public domain? {****************************************************************} {* BACKGROUND MUSIC and MORE ACCURATE TIMING in TP *} {* By Chunqing Cheng *} {*************See music.pas for more detail**********************} program MUSIC_and_TIMER_demo; uses crt,music,dos; var oldcursor,h,m,s,sd:word; ch:char; procedure Cursoron; var Regs:Registers; begin Regs.ah:=1; Regs.cx:=OldCursor; intr($10,Regs); end; procedure Cursoroff; var Regs:Registers; begin Regs.ah:=3; intr($10,Regs); OldCursor:=Regs.cx; Regs.ah:=1; Regs.cx:=$2000; intr($10,Regs); end; procedure beep; begin sound(500); delay(1000); nosound; end; var i1,i2 : longint; begin Increase_Clock_speed_By:=5; clrscr; cursoroff; initspeaker; read_music_data('jingle.mus'); ch:=' '; gotoxy(1,2);write('press Ctrl_D to play DoReMe'); gotoxy(1,3);write('Press Ctrl_J to play JINGLE BELL'); gotoxy(1,5);write('Press Ctrl_Q to toggle background music on and off'); gotoxy(1,6);write('Press Ctrl_C to end the program'); gotoxy(1,7);write('Press ESC to get beep'); gotoxy(1,10);write(' BACKGROUND MUSIC IS: '); gotoxy(1,15); writeln('Begin timing...'); gotoxy(25,10); if background_sound then write('on ') else write('off'); i1:=click; repeat gettime(h,m,s,sd); gotoxy(70,1); if h<10 then write('0'); write(h); if m<10 then write(':0') else write(':'); write(m); if s<10 then write(':0') else write(':'); write(s); if keypressed then ch:=readkey; if ch=#27 then begin beep;ch:=' ';end; if ch=^Q then begin background_sound:=not background_sound; gotoxy(25,10); ch:=' '; if background_sound then write('on ') else write('off'); end; if ch=^J then begin read_music_data('jingle.mus');ch:=' ';end; if ch=^D then begin read_music_data('123.mus');ch:=' ';end; until ch=^C; i2:=click; cursoron; gotoxy(1,17); writeln('Stop timing'); turnoffspeaker; {restore the original timer} gotoxy(1,20); write('Background music is on for: '); writeln((i2-i1)*0.0549/INCREASE_CLOCK_SPEED_BY:6:3,' sec.'); writeln; write('Press RETURN to end'); readln; end. {****************************************************************} {* BACKGROUND MUSIC and MORE ACCURATE TIMING in TP *} {* By Chunqing Cheng *} {****************************************************************} {===== unit MUSIC.pas =======} {This program is written for two purposes: } { 1. Run background music while running application program} { global boolean Background_sound turns it on and off } { more elgent timing can be achieved by increasing } { the value of global INCREASE_CLOCK_SPEED_BY } { before call INITSPEAKER } { USAGE: INCREASE_CLOCK_SPEED_BY:= n; optional } { INITSPEAKER; } { READ_MUSIC_DATA(filename); } { TURNOFFSPEAKER; } { 2. Do more accurate timing by geting global CLICK value } { each click = 0.0549/INCREASE_CLOCK_SPEED_BY (sec) } { USAGE: starttime := click; } { something here to do } { endtime := click; } { ELASPED_TIME:= 0.0549* } { (endtime-starttime)/INCREASE_CLOCK_SPEED_BY} {Credits: Frequency equations derived from TP v3.0 sound demo file } { Background sound from Kevin Weiner: krw1@ns.cc.lehigh.edu } { Reprogram Timer chip from Wayne D. Geiser "Making C Sing" } {NOTES: TP nosound is the same as Turnoffspeaker, so, while runing} { background music, do not call NOSOUND. } {USE with CAUTION, do not forget to restore original timer at the end } {Tempo is one whole note per second} {$r-,s-} {$define AlterTimer} unit music; interface uses dos, crt; const {$ifdef AlterTimer} INCREASE_CLOCK_SPEED_BY : byte = 1; {$else} INCREASE_CLOCK_SPEED_BY : byte = 1; {$endif} Background_sound:boolean = true; var click : longint; procedure initspeaker; procedure turnoffspeaker; procedure nosound; procedure read_music_data(filename:string); implementation type NoteType=(LAGATO, NORMAL, STACATO); {1, 0.875, 0.75} const maxnotes = 600; SoundLength:real=0.875; Ticks_per_sec : real = 18.2; var count, eventnum, nevents: integer; event: array [1..maxnotes] of record ticks: integer; duration: integer; end; oldtimerint: pointer; function inport(x: integer): byte; begin inline($5a/$eb/$00/$ec); end; procedure nosound; begin port[$42] := $08; port[$42] := 0; end; procedure newtimerint; interrupt; const play:boolean=true; begin if nevents>0 then begin dec(count); if Not Background_sound then begin port[$42] := $08; port[$42] := 0; end else if eventnum < nevents then if count <= 0 then begin if play then inc(eventnum); with event[eventnum] do begin if play then count := trunc(duration*SoundLength) else count := duration-trunc(duration*SoundLength); if play and Background_sound then begin port[$42] := lo(ticks); port[$42] := hi(ticks); end else begin port[$42] := $08; port[$42] := 0; end; play:=not play; end; if eventnum=nevents then eventnum:=0; end; end; {$ifdef AlterTimer} inc(click); if click mod INCREASE_CLOCK_SPEED_BY = 0 then begin inline($9c/$ff/$1e/oldtimerint);end; port[$20]:=$20; {$else} inline($9c/$ff/$1e/oldtimerint); {$endif} end; procedure initspeaker; var i : word; begin {$ifdef AlterTimer} getintvec($08,oldtimerint); {save system timer 18.2/sec} setintvec($08,@newtimerint); {Hook to new system timer } i := trunc(65536/INCREASE_CLOCK_SPEED_BY); {Increase timer speed} port[$43]:=$36; {tell 8253 that count is coming} port[$40]:=lo(i); {send low-order byte} port[$40]:=hi(i); {send high-order byte} {$else} getintvec($1c, oldtimerint); setintvec($1c, @newtimerint); {$endif} count := 0; nevents := 0; eventnum := 0; click:=0; port[$43] := $b6; {Counter 2, mode 3, LSB+MSB} port[$42] := $08; {Init timer value - no audible sound} port[$42] := $00; port[$61] := inport($61) or 3; end; procedure turnoffspeaker; begin port[$61] := inport($61) and $fc; {$ifdef AlterTimer} setintvec($08,oldtimerint); {Slow down the system timer} port[$43]:=$36; port[$40]:=0; port[$40]:=0; {$else} setintvec($1c, oldtimerint); {$endif} end; Function BaseF(BaseChar:char) : real; const Sp = 1.059463094; {A=440HZ, div/mul by 12th root of 2} var x : real; begin x := sp*sp; case Upcase(BaseChar) of 'C' : BaseF := 32.625; 'D' : BaseF := 32.625 * x; 'E' : BaseF := 32.625 * x*x; 'F' : BaseF := 32.625 * x*x*sp; 'G' : BaseF := 32.625 * x*x*x*sp; 'A' : BaseF := 32.625 * x*x*x*x*sp; 'B' : BaseF := 32.625 * x*x*x*x*x*sp; end; end; procedure read_music_data(filename:string); var duration,BaseFrequency,Frequency,notelength : real; I,n : integer; BaseChar,note,halfnote : char; notefile : text; s,str80 : string[80]; str3 : string[3]; Inote,Octave : byte; begin assign(notefile,filename); {$I-} reset(notefile); {$I+} if IOResult<>0 then exit; readln(notefile,str80); s:=''; while (str80[1]=' ') and (length(str80)>0) do delete(str80,1,1); val(str80,duration,i); if i>0 then begin s:=copy(str80,1,i-1); delete(str80,1,i-1); val(s,duration,i); end; if duration>0 then Ticks_per_sec:=Ticks_per_sec*Duration; while (str80[1]=' ') and (length(str80)>0) do delete(str80,1,1); case str80[1] of '1','L','l' : SoundLength:=1.0; '2','N','n' : SoundLength:=0.875; '3','S','s' : SoundLength:=0.75; end; i := 0; repeat begin BaseChar := str80[length(str80)-i]; i := i + 1; end; until upcase(BaseChar) in ['C'..'G','A','B']; INote := INote mod 13; BaseFrequency := BaseF(BaseChar); n:=0; while not eof(notefile) do begin readln(notefile,Octave,str3,notelength); note := str3[2]; halfnote := str3[3]; i := 0; case Halfnote of '+','#','s','S','F','f' : i := 1; { Take care } '-' : i := -1; { Sharp tone } end; case upcase(note) of 'C','1' : i := 1 + i; 'D','2' : i := 3 + i; 'E','3' : i := 5 + i; 'F','4' : i := 6 + i; 'G','5' : i := 8 + i; 'A','6' : i := 10 + i; 'B','7' : i := 12 + i; else i := 0; end; INote := i; Duration := trunc(Ticks_per_sec*notelength); Frequency:=BaseFrequency; for I := 1 to Octave do Frequency := Frequency * 2; for I := 1 to INote - 1 do Frequency := Frequency * 1.059463094; if Frequency>30000 then Frequency:=30000; n:=n+1; if Inote=0 then event[n].ticks:=$08 else {1193180???} event[n].ticks := trunc(1193182.0/frequency +0.5); NoteLength:=duration*INCREASE_CLOCK_SPEED_BY; event[n].duration := trunc(notelength{*SoundLength}); end; close(notefile); nevents := n; end; begin end. {========== JINGLE.MUS =============} 1.0 NORMAL/I = E 4 0 1 4 3 0.5 4 2 0.5 4 1 0.5 3 5 1 4 0 0.5 3 5 0.25 3 5 0.25 3 5 0.5 4 3 0.5 4 2 0.5 4 1 0.5 3 6 1 4 0 1 3 6 0.5 4 4 0.5 4 3 0.5 4 2 0.5 3 7 1 4 0 1 4 5 0.5 4 5 0.5 4 4 0.5 4 2 0.5 4 3 1 4 1 0.5 4 0 0.5 3 5 0.5 4 3 0.5 4 2 0.5 4 1 0.5 3 5 1 4 0 1 3 5 0.5 4 3 0.5 4 2 0.5 4 1 0.5 3 6 1 4 0 0.5 3 6 0.5 3 6 0.5 4 4 0.5 4 3 0.5 4 2 0.5 4 5 0.5 4 5 0.5 4 5 0.5 4 5 0.5 4 6 0.5 4 5 0.5 4 4 0.5 4 2 0.5 4 1 1.5 4 0 0.5 4 3 0.5 4 3 0.5 4 3 1 4 3 0.5 4 3 0.5 4 3 1 4 3 0.5 4 5 0.5 4 1 0.75 4 2 0.25 4 3 1.5 4 0 0.5 4 4 0.5 4 4 0.5 4 4 0.75 4 4 0.25 4 4 0.5 4 3 0.5 4 3 0.5 4 3 0.25 4 3 0.25 4 3 0.5 4 2 0.5 4 2 0.5 4 1 0.5 4 2 1 4 5 1 4 3 0.5 4 3 0.5 4 3 1 4 3 0.5 4 3 0.5 4 3 1 4 3 0.5 4 5 0.5 4 1 0.75 4 2 0.25 4 3 1.5 4 0 0.5 4 4 0.5 4 4 0.5 4 4 0.75 4 4 0.25 4 4 0.5 4 3 0.5 4 3 0.5 4 3 0.25 4 3 0.25 4 5 0.5 4 5 0.5 4 4 0.5 4 2 0.5 4 1 1.5 4 0 0.5 {============= 123.mus ==================} 1 Stacato/I = C 3 5 0.5 4 5 0.5 3 5 0.5 4 5 0.5 3 5 0.5 4 5 0.5 3 5 0.5 4 5 0.5 3 5 0.5 4 5 0.5 3 5 0.5 4 5 0.5 3 5 0.5 4 5 0.5 4 5 1 4 5 1 4 5 0.5 4 5 0.5 4 6 0.5 4 6 0.5 4 7 1 4 5 0.5 4 5 3 4 5 0.5 4 5 0.75 4 5 0.25 4 5 1 4 6 1.5 4 7 0.5 4 5 3 4 5 0.5 4 5 0.5 4 4 1 4 4 0.5 4 4 0.5 4 4 1 4 5 1 4 3 1 4 3 1 4 3 1 4 3 0.5 4 5 0.5 4 4 1 4 4 0.5 4 4 0.5 4 3 1 4 2 1 4 1 1 4 2 1 4 3 2 4 1 1 4 2 1 4 3 2 4 1 1 4 2 1 4 3 1.5 5 1 0.5 4 7 1 4 6 1 4 5 1 4 4 1 4 3 0.5 4 3 0.5 4 4 1 4 5 2 4 1 1 4 2 1 4 3 2 4 1 1 4 2 1 4 3 1 4 0 1 4 1 0.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 0.5 4 0 6.5 4 1 0.5 5 1 0.5 4 7 0.5 4 6 0.5 4 5 0.5 4 4 0.5 4 3 0.5 4 2 0.5 4 1 1.5 4 2 0.5 4 3 1.5 4 1 0.5 4 3 1 4 1 1 4 3 1 4 0 1 4 2 1.5 4 3 0.5 4 4 0.5 4 4 0.5 4 3 0.5 4 2 0.5 4 4 4 4 3 1.5 4 4 0.5 4 5 1.5 4 3 0.5 4 5 1 4 3 1 4 5 2 4 4 1.5 4 5 0.5 4 6 0.5 4 6 0.5 4 5 0.5 4 4 0.5 4 6 4 4 5 1.5 4 1 0.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 4 4 6 1.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 4 4 7 1.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 0.5 5 1 3 4 7 0.5 4 7 0.5 4 6 1 4 4 1 4 7 1 4 5 1 5 1 1 4 5 1 4 3 1 4 2 1 4 1 1 4 0 0.5 4 1 1 4 0 0.5 4 2 0.5 4 3 1.5 4 1 0.5 4 3 1 4 1 1 4 3 2 4 2 1 4 0 0.5 4 3 0.5 4 4 0.5 4 4 0.5 4 3 0.5 4 2 0.5 4 4 4 4 3 1 4 0 0.5 4 4 0.5 4 5 1.5 4 3 0.5 4 5 1 4 3 1 4 5 2 4 4 1 4 0 0.5 4 5 0.5 4 6 0.5 4 6 0.5 4 5 0.5 4 4 0.5 4 6 4 4 5 1.5 4 1 0.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 4 4 6 1.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 4 4 7 1.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 0.5 5 1 3 4 7 0.5 4 7 0.5 4 6 1 4 4 1 4 7 1 4 5 1 4 1 1.5 4 2 0.5 4 3 1.5 4 1 0.5 4 3 1 4 1 1 4 3 2 4 2 1.5 4 3 0.5 4 4 0.5 4 4 0.5 4 3 0.5 4 2 0.5 4 4 4 4 3 1.5 4 4 0.5 4 5 1.5 4 3 0.5 4 5 1 4 3 1 4 5 2 4 4 1.5 4 5 0.5 4 6 0.5 4 6 0.5 4 5 0.5 4 4 0.5 4 6 4 4 5 1.5 4 1 0.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 4 4 6 1.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 4 4 7 1.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 0.5 5 1 3 4 7 0.5 4 7 0.5 4 6 1 4 4 1 4 7 1 4 5 1 5 1 4 4 0 0.5 4 1 0.5 4 2 0.5 4 3 0.5 4 4 0.5 4 5 0.5 4 6 0.5 4 7 0.5 5 1 1 4 5 1 5 1 1 4 0 1 {end of four files} Chunqing Cheng