home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / m / m003_1 / sdk_dos.ddi / TPASCAL / CDAUDIO / DEMOCD.PAS
Encoding:
Pascal/Delphi Source File  |  1991-10-28  |  3.7 KB  |  143 lines
  1. { ------------------------------------------------------------------------ }
  2. {   Title     : DEMOCD.PAS                           ** TP6 Version ***    }
  3. {                                                                          }
  4. {   Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.  }
  5. { ------------------------------------------------------------------------ }
  6.  
  7. program democd;
  8.  
  9. { Include the SBC Unit, and any other units needed }
  10. uses sbc_tp6, dos, crt;
  11.  
  12.  
  13. var
  14.     dummy : integer;
  15.  
  16. { ------------------------------------------------------------------------ }
  17.  
  18. procedure Display;
  19. begin
  20.     ClrScr;
  21.     writeln('Compact Disc Player Demo Program');
  22.     writeln;
  23.     writeln('     P  : Play');
  24.     writeln('     S  : Stop');
  25.     writeln('     A  : Pause');
  26.     writeln('     C  : Continue');
  27.     writeln('     N  : Next Track');
  28.     writeln('     L  : Previous Track');
  29.     writeln('     F  : Fast Forword');
  30.     writeln('     R  : Rewind');
  31.     writeln('     Q  : Quit');
  32.     writeln;
  33.     writeln;
  34. end;
  35.  
  36.  
  37. { ------------------------------------------------------------------------ }
  38.  
  39. function BCD2Binary (data : byte) : byte;
  40. begin
  41.     BCD2Binary := (data shr 4)*10 + (data and $f);
  42. end;
  43.  
  44.  
  45. { ------------------------------------------------------------------------ }
  46.  
  47. function HSG2RED(data : longint) : longint;
  48. var
  49.     v0, v1, v2 : longint;
  50.  
  51. begin
  52.     v2 := data div 4500;    { 4500 = 60 * 75 }
  53.     v1 := (data mod 4500) div 75;
  54.     v0 := (data mod 4500) mod 75;
  55.  
  56.     HSG2RED := (v2 shl 16) or (v1 shl 8) or v0;
  57. end;
  58.  
  59.  
  60. { ------------------------------------------------------------------------ }
  61.  
  62. procedure ShowInfo;
  63. var
  64.     qch_info : QCHAN_INFO;
  65.     volume : longint;
  66.     vol1, vol2 : byte;
  67.  
  68. begin
  69.     dummy := sbcd_get_loc_info( qch_info );
  70.     dummy := sbcd_get_volume( volume );
  71.     volume := HSG2RED( volume );
  72.  
  73.     vol1 := byte((volume shr 16) and $ff);
  74.     vol2 := byte((volume shr 8) and $ff);
  75.  
  76.     write('Disc - ', qch_info.pmin:2,':', qch_info.psec:2,
  77.           '  Track - ', BCD2Binary(qch_info.tno):2, ' ',
  78.           qch_info.min:2, ':', qch_info.sec:2,
  79.           '  Vol - ', vol1:2, ':', vol2:2, #13);
  80.  
  81. end;
  82.  
  83.  
  84. { ------------------------------------------------------------------------ }
  85.  
  86. const
  87.     SKIP_SEC    = 16;
  88.  
  89. var
  90.     key : char;
  91.     drv_num : integer;
  92.     quit : boolean;
  93.  
  94. { main function }
  95.  
  96. begin  { program body }
  97.  
  98.     quit := False;
  99.  
  100.     if sbcd_init(drv_num) = 0 then begin
  101.  
  102.         Display;
  103.  
  104.         repeat
  105.             ShowInfo;
  106.  
  107.             if keyPressed then begin
  108.                 key := ReadKey;
  109.  
  110.                 { not extended key }
  111.                 if (key <> #0) then begin
  112.                     key := UpCase(key);
  113.  
  114.                     case (key) of
  115.                         'P' :
  116.                             dummy := sbcd_play(1,0,$ffff);
  117.                         'S' :
  118.                             dummy := sbcd_stop;
  119.                         'A' :
  120.                             dummy := sbcd_pause;
  121.                         'C' :
  122.                             dummy := sbcd_continue;
  123.                         'N' :
  124.                             dummy := sbcd_next_track;
  125.                         'L' :
  126.                             dummy := sbcd_prev_track;
  127.                         'F' :
  128.                             dummy := sbcd_fastforward(SKIP_SEC);
  129.                         'R' :
  130.                             dummy := sbcd_rewind(SKIP_SEC);
  131.                         'Q' :
  132.                             quit := True;
  133.                     end;
  134.                 end
  135.                 else
  136.                     key := ReadKey;
  137.             end;
  138.         until quit;
  139.     end
  140.     else
  141.         writeln('Initialization error.');
  142. end.
  143.