home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PINBSRC.ZIP / _CDPLAYR.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-02  |  9KB  |  276 lines
  1. CONST StaText : array[-3..11] of string = (
  2.                 {erros}
  3.                 'CD changed',
  4.                 'No CD-DA! ',
  5.                 'No CD-ROM!',
  6.                 'Ready     ',
  7.                 {status}
  8.                 'Play      ',
  9.                 'Pause     ',
  10.                 'Stop      ',
  11.                 'Skip '+#16+'│   ',
  12.                 'Skip │'+#17+'   ',
  13.                 'Search '+#16+#16+' ',
  14.                 'Search '+#17+#17+' ',
  15.                 'Open Tray ',
  16.                 'Close Tray',
  17.                 'Un/Shuffle',
  18.                 'Introplay ');
  19.  
  20. VAR
  21.   maxTitles : integer;
  22.   Actual    : integer;
  23.   status : integer;
  24.   cdende : boolean;
  25.  
  26.   rr : char;
  27.  
  28.   timeinfo : QChannel_Info;
  29.  
  30.   oldtrack,oldtmin,oldtsec : byte;
  31.  
  32. function out(t1,t2:byte):string;
  33.   var z : string;
  34. begin
  35.   z := '';
  36.   if t1 < 10 then z := '0'+inttostr(t1) else z := inttostr(t1);
  37.   z := z + ':';
  38.   if t2 < 10 then z := z + '0'+inttostr(t2) else z := z + inttostr(t2);
  39.   out := z;
  40. end;
  41.  
  42. procedure CDROMStatus(t:integer);
  43.   var a : byte;
  44. begin
  45.   Status := t;
  46.   repeat led_anzeige; until led_status = 0;
  47.   led_anzeige_5_init(3*8,0,StaText[t]);
  48.   repeat led_anzeige; until led_status = 0;
  49. end;
  50.  
  51. procedure TrackTyp;
  52.   var z : string;
  53. begin
  54.   actual := Get_Actual_Track;
  55.   if actual > maxTitles then begin
  56.       Stop_audio_1;
  57.       Play_Tracks(longint(1),longint(maxTitles));
  58.       Stop_Audio_1;
  59.       actual := Get_Actual_Track;
  60.       CDROMStatus(3);
  61.     end;
  62.   if actual <> oldtrack then begin
  63.       oldtrack := actual;
  64.       z := '';
  65.       if actual < 10 then z := z + '0';
  66.       z := z + inttostr(actual) + '/';
  67.       if maxtitles < 10 then z := z + '0';
  68.       z := z + inttostr(maxTitles);
  69.       led_anzeige_5_init(4*8,8,z);
  70.       repeat led_anzeige; until led_status = 0;
  71.     end;
  72.   if Get_Track_Info(actual) = $40 then begin
  73.       CDROMStatus(3); Stop_Audio_1; end;
  74. end;
  75.  
  76. procedure Time;
  77. begin
  78.   read_qChannel(timeinfo);
  79.   if (Audio_Busy <> 0) then
  80.         begin
  81.           with timeinfo do begin
  82.             if tsec <> oldtsec then begin
  83.                 oldtsec := tsec;
  84.                 led_anzeige_5_init(15*8,8,out(tMin,tSec));
  85.                 repeat led_anzeige; until led_status = 0;
  86.     {            write('Total Time: '); out(dMin,dSec);}
  87.               end;
  88.           end;
  89.         end else if (status = 3) or (status = 0) then
  90.         begin
  91.           with timeinfo do begin
  92.             if tsec <> oldtsec then begin
  93.                 oldtsec := tsec;
  94.                 led_anzeige_5_init(15*8,8,'00:00');
  95.                 repeat led_anzeige; until led_status = 0;
  96.     {            write('Total Time: 00:00');}
  97.               end;
  98.           end;
  99.         end;
  100. end;
  101.  
  102. procedure ResetMenu;
  103. begin
  104.   led_anzeige_5_init(0, 0,'CD:             >__<');
  105.   repeat led_anzeige until led_status = 0;
  106.   led_anzeige_5_init(0, 8,'No.:00/00 Time:00:00');
  107.   repeat led_anzeige until led_status = 0;
  108. end;
  109.  
  110. procedure Init;
  111.   var rr : byte;
  112.       k : char;
  113. begin
  114. oldtrack := 255; oldtmin := 255; oldtsec := 255;
  115. resetmenu; cdende := false;
  116. k := #0;
  117.   repeat
  118.     maxTitles := Init_CDAudio;
  119.     if maxTitles < 0 then CDROMStatus(maxTitles);
  120.     if keypressed then begin
  121.                        case upcase(readkey) of
  122.                          #27,'Q' : begin cdende := true; exit; end;
  123.                          'C' : begin CDROMStatus(9); Insert_CD; end;
  124.                          'P' : begin k := 'P';
  125.                                      CDROMStatus(1); Insert_CD; end;
  126.                          'O' : begin CDROMStatus(8); Eject_CD;end;
  127.                        end;
  128.                      end;
  129.   until maxTitles > 0;
  130.   actual := Get_Actual_Track;
  131.   CDROMStatus(0);
  132.   if audio_busy <> 0 then k := 'P';
  133.   if Audio_Pause = 0 then begin
  134.       if k = 'P' then begin
  135.           rr := 1;
  136.           repeat
  137.             Play_Tracks(longint(rr),longint(maxTitles));
  138.             inc(rr);
  139.           until (rr > maxTitles) or (Audio_Busy <>0);
  140.           CDROMStatus(1);
  141.         end else begin
  142.            Play_Tracks(longint(1),longint(maxTitles));
  143.            Stop_Audio_1;
  144.            CDROMStatus(3);
  145.          end;
  146.     end else CDROMStatus(2);
  147.   cdende := false; actual := 0;
  148.   TrackTyp;
  149.  
  150. actual := 1;
  151. end;
  152.  
  153. procedure CDPLayer;
  154.  
  155. {begin of HP}
  156.   label start;
  157.  
  158.   var t : array[0..1] of char;
  159.       p : byte;
  160.       check : integer;
  161.       alt : byte;
  162.  
  163. begin
  164. start:
  165.   p := 0; t[0] := '_'; t[1] := '_';
  166.   Init; if cdende then exit;
  167.   repeat
  168.     Time;
  169.     TrackTyp;
  170.     if (Status = 1 {play}) and (Audio_Busy = 0) then
  171.        begin CDROMStatus(status); rr := #0; CD_Reset; goto start; end;
  172. (*    if (Status = 2 {pause}) and (Audio_Pause = 0) then
  173.        begin CD_Reset; screenmask; goto start; end;*)
  174.     rr := #0;
  175.     if keypressed then rr := upcase(readkey);
  176.     case rr of
  177.         '+' : begin
  178.                 CDROMStatus(6); Skip_Audio(15*75);
  179.                 CDROMStatus(1);
  180.               end;
  181.         '-' : begin
  182.                 CDROMStatus(7); Skip_Audio(-15*75);
  183.                 CDROMStatus(1);
  184.               end;
  185.         'K' : begin
  186.                 CDROMStatus(5);
  187.                 dec(actual); if actual < 1 then actual := maxTitles;
  188.                 Stop_Audio_1;
  189.                 Play_Tracks(longint(actual), longint(maxTitles));
  190.                 CDROMStatus(1);
  191.               end;
  192.         'M' : begin
  193.                 CDROMStatus(4);
  194.                 inc(actual); if actual > maxTitles then actual := 1;
  195.                 Stop_Audio_1;
  196.                 Play_Tracks(longint(actual), longint(maxTitles));
  197.                 CDROMStatus(1);
  198.               end;
  199.         'P' : IF (Audio_Busy <> 0) THEN begin
  200.                        CDROMStatus(2);
  201.                        Stop_Audio_1
  202.                      end else begin
  203.                        CDROMStatus(1);
  204.                        Resume_Audio_1;
  205.                      end;
  206.         'S' : {IF (Audio_Busy <> 0) THEN} begin
  207.                       read_qChannel(timeinfo);
  208.                       Skip_Audio(-timeinfo.tmin*4500
  209.                                  -timeinfo.tsec*75
  210.                                  -timeinfo.tframe);
  211.                        CDROMStatus(3);
  212.                        Stop_Audio_1;
  213.                     end;
  214.         'O' : begin CDROMStatus(8); Eject_CD; goto start; end;
  215.         'C' : begin CDROMStatus(9); Insert_CD; end;
  216.         #8 : begin t[0] := '_'; t[1] := '_';
  217.                      led_anzeige_5_init(17*8,0,t[0]+t[1]);
  218.                      repeat led_anzeige; until led_status = 0;
  219.                      p := 0;
  220.                end;
  221.         '0'..'9',#13 : begin
  222.                      t[1] := '_';
  223.                      t[p] := rr;
  224.                      if (rr = #13) and (p=1) then begin
  225.                          t[1] := t[0]; t[0] := '0';
  226.                        end else if rr = #13 then rr := #0;
  227.                      if rr <> #0 then begin
  228.                          inc(p);
  229.                          if p = 2 then begin
  230.                              val(t[0]+t[1],p,check);
  231.                              if (p < 1) or (p > maxTitles) then
  232.                                begin t[0] := '_'; t[1] := '_'; end
  233.                                else begin Stop_Audio_1;
  234.                                  CDROMStatus(1);
  235.                                  Play_Tracks(longint(p),
  236.                                              longint(maxTitles));
  237.                                end;
  238.                              p := 0;
  239.                            end;
  240.                          led_anzeige_5_init(17*8,0,t[0]+t[1]);
  241.                          repeat led_anzeige; until led_status = 0;
  242.                      end;
  243.                    end;
  244.       end;
  245.   until (rr = #27) or (rr = 'Q');
  246. END;
  247.  
  248. procedure StartCDPLayer;
  249.   var b : word;
  250. begin
  251.   for b := CurrentPos to 400 do begin
  252.       retrace; setlinecomp(b); end;
  253.   ResetMenu;
  254.   case VideoMode of
  255.     '2' : CurrentPos := 332;
  256.     '0' : CurrentPos := 332;
  257.     '3' : CurrentPos := 366;
  258.     '1' : CurrentPos := 366;
  259.   end;
  260.   for b := 400 downto CurrentPos do begin
  261.       retrace; setlinecomp(b); end;
  262.   CDPlayer;
  263.   for b := CurrentPos to 400 do begin
  264.       retrace; setlinecomp(b); end;
  265.   CurrentPos := 400;
  266.   led_anzeige_5_init(0,0,'Continue playing ...');
  267.   repeat led_anzeige until led_status = 0;
  268.   led_anzeige_5_init(0,8,'                    ');
  269.   repeat led_anzeige until led_status = 0;
  270.   for b := 400 downto NormalPos do begin
  271.       retrace; setlinecomp(b); end;
  272.   currentpos := normalpos;
  273. end;
  274.  
  275.  
  276.