home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / AMOD095.ZIP / AMODTSR.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-21  |  3KB  |  134 lines
  1. {$m 2000,29000,29000}
  2. {$s-}
  3. {$n-}
  4. {$e-}
  5. uses dos,modunit,memunit;
  6. type
  7. p_string = ^string;
  8. var
  9.   vol,c : integer;
  10.   oldintfc,oldint9,oldint28 : procedure;
  11.   canload,loaded : boolean;
  12.   filename : p_string;
  13.  
  14. {$i tsr.inc}
  15.  
  16. procedure newint28; interrupt;
  17. begin
  18.   if canload and not loaded then begin
  19.     loaded := true;
  20.     canload := false;
  21.     port[$3c8] := 0;
  22.     port[$3c9] := 20;
  23.     port[$3c9] := 20;
  24.     port[$3c9] := 20;
  25.     {stop_playing;
  26.     free_mod;
  27.     load_mod('no_party.mod');
  28.     start_playing;}
  29.     port[$3c8] := 0;
  30.     port[$3c9] := 0;
  31.     port[$3c9] := 0;
  32.     port[$3c9] := 0;
  33.   end;
  34.   asm
  35.     pushf
  36.     call oldint28;
  37.   end;
  38. end;
  39.  
  40. procedure newint9; interrupt;
  41. begin
  42.   if port[$60] = $bc then begin
  43.     loaded := false;
  44.   end;
  45.   if (mem[$40:$17] and 16 <> 0) and (port[$60]=$3c) then begin
  46.     canload := true;
  47.   end;
  48.   asm
  49.     pushf
  50.     call oldint9
  51.   end;
  52. end;
  53.  
  54. function findgus : word;
  55. var
  56. n,c,i : word;
  57. s : string;
  58. begin
  59.   s := getenv('ultrasnd');
  60.   if s = '' then begin
  61.     findgus := 0;
  62.     exit;
  63.   end;
  64.   val(copy(s,1,3),n,c);
  65.   if c <> 0 then begin
  66.     findgus := 0;
  67.     exit;
  68.   end;
  69.   case n of
  70.     210 : i := $210;
  71.     220 : i := $220;
  72.     230 : i := $230;
  73.     240 : i := $240;
  74.     250 : i := $250;
  75.     260 : i := $260;
  76.     270 : i := $270;
  77.     else begin
  78.       findgus := 0;
  79.       exit;
  80.     end;
  81.   end;
  82.   for n := 1 to 3 do delete(s,1,pos(',',s));
  83.   if gus_irq = 0 then begin
  84.     val(copy(s,1,pos(',',s)-1),gus_irq,c);
  85.     if c <> 0 then gus_irq := 0;
  86.   end;
  87.   findgus := i;
  88. end;
  89.  
  90. function addext(str,ext: string) : string;
  91. begin
  92.   if pos('.',str) > 0 then addext := str
  93.   else addext := str+ext;
  94. end;
  95.  
  96. begin
  97.   writeln('AMODTSR v 0.95');
  98.   if paramcount < 1 then begin
  99.     writeln('Usage: AMODTSR MODULE [vol]');
  100.     exit;
  101.   end;
  102.   gus_base := findgus;
  103.   if gus_base < $200 then gus_base := $200;
  104.   gusfind;
  105.   gusreset;
  106.   init_mod;
  107.   amp_vol := 15;
  108.   if paramcount > 1 then begin
  109.     val(paramstr(2),vol,c);
  110.     if vol <> 0 then amp_vol := vol;
  111.   end;
  112.   if initxms <> 0 then exit;
  113.   if paramstr(1) <> '/' then begin
  114.     load_mod(addext(paramstr(1),'.mod'));
  115.     if mod_error <> 0 then begin
  116.       writeln('Error ',mod_error,' loading module');
  117.       donexms;
  118.       exit;
  119.     end;
  120.     start_playing;
  121.   end;
  122.   canload := false;
  123.   loaded := false;
  124.   getintvec($fc,@oldintfc);
  125.   setintvec($fc,@intfc);
  126.   exec(getenv('COMSPEC'),'');
  127.   setintvec($fc,@oldintfc);
  128.   stop_playing;
  129.   free_mod;
  130.   donexms;
  131.   done_mod;
  132. end.
  133.  
  134.