home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sound / oscillo / oscil.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-06  |  7.5 KB  |  265 lines
  1. program OSCILLISCOPE;  { Reads VOC files and displays OSCILLISCOPE
  2.                          By Corey Roome
  3.                          9:19 pm
  4.                          1/29/92 }
  5.  
  6. uses
  7.   Crt, Graph;
  8.  
  9. var
  10.   Gd, Gm : Integer;               { Graphics mode and driver }
  11.   KEY, STFIL : char;              { What Key and the character }
  12.   FNM : Text;                     { File Name }
  13.   OX, OY : Integer;               { Old X and Y positions }
  14.   XLOC, COUNT : Integer;          { Location of X and COUNTING }
  15.   BUF : Integer;                  { Buffer to fill }
  16.   NODES : Integer;                { How many nodes at once }
  17.   JMP : Integer;                  { How far to jump }
  18.   PAUSE : Integer;                { Timing Delay }
  19.   Y3DLOC, X3DLOC : Integer;       { Where 3D X and Y are NOW }
  20.   DIRECT : Integer;               { Which way is 3D X traveling }
  21.   OX3D, OY3D : Integer;           { Old 3D X's and Y's }
  22.   BTM, TOP : Integer;             { Bottom and Top on or off }
  23.   NAME : String;                  { Name of File }
  24.   XJMP, MODE : Integer;           { Mode of the X movement }
  25.   RANDXMAX,RANDXMIN : Integer;    { Max random X,Y freq }
  26.   COLOR : Integer;                { Color number }
  27.   S : String;                     { Little S helper for conversions }
  28.   TESPD : Integer;                { Temporary speed for pause memory }
  29.  
  30.  
  31. procedure INIT;                   { Initilize Variables and Screen }
  32. begin
  33.   TESPD := 0;
  34.   COLOR := 10;
  35.   XJMP := 0;
  36.   MODE := 2;  { 1 is matched, 2 is random }
  37.   RANDXMAX := 255;
  38.   RANDXMIN := 0;
  39.   BTM := 1;
  40.   TOP := 1;
  41.   DIRECT := 1;
  42.   Y3DLOC := 90;
  43.   X3DLOC := 300;
  44.   OX3D := X3DLOC;
  45.   OY3D := Y3DLOC;
  46.   PAUSE := 0;
  47.   NODES := 49;
  48.   JMP := 545 div NODES;
  49.   Gd := 9;
  50.   Gm := 2;
  51.   BUF := 0;
  52.   COUNT := 0;
  53.   XLOC := 1;
  54.   OX := XLOC;
  55.   OY := 325;
  56.   ClrScr;
  57.   Writeln ('Oscilliscope for Sound Blaster VOC files');
  58.   Writeln;
  59.   Writeln ('By Corey Roome');
  60.   Writeln;
  61.   Writeln;
  62.   Writeln ('Keys not included on bottom of screen: ');
  63.   Writeln;
  64.   Writeln ('C: Change color of oscilliscope');
  65.   Writeln ('M: Change mode (simulated stereo, or mono)');
  66.   Writeln;
  67.   Writeln;
  68.   Write ('Enter a FILENAME, including extension (ie COREY.VOC) >');
  69.   Readln (NAME);
  70.   Assign (FNM,NAME);
  71.   InitGraph (Gd, Gm,'C:\TP\BGI');
  72.   SetColor (LightGray);
  73.   SetFillStyle (1,LightGray);
  74.   FloodFill (0,0,11);
  75.   SetColor (DarkGray);
  76.   SetFillStyle (1,Darkgray);
  77.   Bar (30,205,600,455);
  78.   Bar (30,10,310,195);
  79.   Bar (320,10,600,195);
  80.   SetFillStyle (1,Black);
  81.   Bar (325,5,605,190);
  82.   Bar (35,5,315,190);
  83.   Bar (35,200,605,450);
  84.   SetTextStyle (2,HorizDir,4);
  85.   SetColor (EGARed);
  86.   OutTextXY (30,460,'1 --> 0 : SPEED  + : INCREASE NODES  - : DECREASE NODES  T : Top  B : Bottom  P : PAUSE  Q : QUIT');
  87.   SetTextStyle (1,HorizDir,1);
  88.   SetColor (EGAYellow);
  89.   OutTextXY (400,10,'Status Screen');
  90.   SetTextStyle (2,HorizDir,5);
  91.   SetColor (EGAWhite);
  92.   Str(500-PAUSE,S);
  93.   OutTextXY (330,45,'Speed :');
  94.   OutTextXY (390,45,S);
  95.   OutTextXY (330,65,'Mode  :');
  96.   if MODE = 2 then OutTextXY (390,65,'Stereo') else OutTextXY (390,65,'Mono');
  97.   OutTextXY (330,85,'Nodes :');
  98.   Str(NODES,S);
  99.   OutTextXY (390,85,S);
  100.   OutTextXY (330,105,'Top   :');
  101.   if TOP = 1 then OutTextXY (390,105,'On') else OutTextXY (390,105,'Off');
  102.   OutTextXY (330,125,'Bottom :');
  103.   if BTM = 1 then OutTextXY (390,125,'On') else OutTextXY (390,125,'Off');
  104.   SetColor (COLOR);
  105. end;
  106.  
  107. procedure Update;                    { Update Status Bar }
  108. begin
  109.   SetColor (EGAWhite);
  110.   Bar (390,45,480,170);
  111.   Str(500-PAUSE,S);
  112.   OutTextXY (390,45,S);
  113.   if MODE = 2 then OutTextXY (390,65,'Stereo') else OutTextXY (390,65,'Mono');
  114.   Str(NODES,S);
  115.   OutTextXY (390,85,S);
  116.   if TOP = 1 then OutTextXY (390,105,'On') else OutTextXY (390,105,'Off');
  117.   if BTM = 1 then OutTextXY (390,125,'On') else OutTextXY (390,125,'Off');
  118.   SetColor (COLOR);
  119. end;
  120.  
  121. procedure WhatKey;                   { When key is pressed, go here }
  122. begin
  123.   KEY := ReadKey;
  124.   Case upCase(Key) of
  125.     '-' : NODES := NODES - 1;
  126.     '+' : NODES := NODES + 1;
  127.     '1' : PAUSE := 0;
  128.     '2' : PAUSE := 50;
  129.     '3' : PAUSE := 100;
  130.     '4' : PAUSE := 150;
  131.     '5' : PAUSE := 200;
  132.     '6' : PAUSE := 250;
  133.     '7' : PAUSE := 300;
  134.     '8' : PAUSE := 350;
  135.     '9' : PAUSE := 400;
  136.     '0' : PAUSE := 450;
  137.     'B' : begin
  138.       if BTM = 1 then BTM := 0 else BTM := 1;
  139.       if BTM = 0 then BAR (35,200,605,450);
  140.       end;
  141.     'T' : begin
  142.       if TOP = 1 then TOP := 0 else TOP := 1;
  143.       if TOP = 0 then BAR (35,5,315,190);
  144.       end;
  145.     'M' : begin
  146.       if MODE = 1 then MODE := 2 else MODE := 1;
  147.       end;
  148.     'C' : begin
  149.       INC(COLOR);
  150.       if COLOR > 15 then COLOR := 1;
  151.       end;
  152.   end;
  153.   if NODES < 22 then NODES := 22;
  154.   if NODES > 70 then NODES := 70;
  155.   JMP := 545 div NODES;
  156.   update;
  157. end;
  158.  
  159. procedure Display3D;                    { Display 3D Oscilliscope }
  160. begin
  161.   if MODE = 1 then begin
  162.   IF ORD(STFIL)> 128 then X3DLOC := X3DLOC + (ORD(STFIL)-129);
  163.   IF ORD(STFIL)< 129 then X3DLOC := X3DLOC + (ORD(STFIL)-129);
  164.   end;
  165.   if MODE = 2 then begin
  166.   IF XJMP> 128 then X3DLOC := X3DLOC + (XJMP-129);
  167.   IF XJMP< 129 THEN X3DLOC := X3DLOC + (XJMP-129);
  168.   end;
  169.   PutPixel (X3DLOC-145,(ORD(STFIL)+80) div 2,COLOR);
  170.   X3DLOC := 320;
  171. end;
  172.  
  173. procedure Reorder;                      { Reorder output for PAUSE }
  174. begin
  175.   OX := XLOC;
  176.   OY := ORD(STFIL)+200;
  177.   if TOP = 1 then Display3D;
  178.   if BUF > NODES then begin
  179.     if upCase (KEY) = 'P' then begin
  180.       TESPD := PAUSE;
  181.       PAUSE := 500;
  182.       update;
  183.       repeat
  184.       until KeyPressed;
  185.       KEY := ' ';
  186.       PAUSE := TESPD;
  187.     end;
  188.     Delay (PAUSE);
  189.     SetFillStyle (SolidFill,0);
  190.     Bar (35,5,315,190);
  191.     BUF := 0;
  192.     XLOC := 0;
  193.     OX := 0;
  194.     OY := 325;
  195.   end;
  196. end;
  197.  
  198. procedure Displayit;                    { Main DISPLAY }
  199. begin
  200.   SetColor (COLOR);
  201.   INC(BUF);
  202.   XLOC := XLOC + JMP;
  203.   if BTM = 0 then reorder;
  204.   if BTM = 0 then exit;
  205.   PutPixel (XLOC+40,ORD(STFIL)+200,COLOR);
  206.   Line (OX+40,OY,XLOC+40,ORD(STFIL)+200);
  207.   OX := XLOC;
  208.   OY := ORD(STFIL)+200;
  209.   if TOP = 1 then Display3D;
  210.   if BUF > NODES then begin
  211.     if upCase (KEY) = 'P' then begin
  212.       TESPD := PAUSE;
  213.       PAUSE := 500;
  214.       update;
  215.       repeat
  216.       until KeyPressed;
  217.       KEY := ' ';
  218.       PAUSE := TESPD;
  219.     end;
  220.     Delay (PAUSE);
  221.     SetFillStyle (SolidFill,0);
  222.     Bar (35,200,605,450);
  223.     if TOP = 1 then Bar (35,5,315,190);
  224.     BUF := 0;
  225.     XLOC := 0;
  226.     OX := 0;
  227.     OY := 325;
  228.   end;
  229. end;
  230.  
  231. procedure Entfile;                    { Enter file into variable }
  232. begin
  233.   Reset (FNM);
  234.   SetColor (COLOR);
  235.   Repeat
  236.     Repeat
  237.       inc(COUNT);
  238.       Read (FNM,STFIL);
  239.       if (MODE = 2) and (TOP = 1) then begin
  240.         if DIRECT = -1 then XJMP:=XJMP-3;
  241.         if DIRECT = 1 then XJMP:=XJMP+3;
  242.         if (XJMP<RANDXMIN) or (XJMP>RANDXMAX) then begin
  243.           if DIRECT = 1 THEN DIRECT := -1 ELSE DIRECT := 1;
  244.           RANDXMAX:=Random(255);
  245.           RANDXMIN:=Random(255);
  246.           if RANDXMAX < 190 then RANDXMAX := 190;
  247.           if RANDXMIN > 100 then RANDXMIN := 100;
  248. {         if (ORD(STFIL) > 137) and (RANDXMAX > ORD(STFIL)+10) then RANDXMAX := ORD(STFIL)+10;
  249.           if (ORD(STFIL) < 137) and (RANDXMIN < ORD(STFIL)-10) then RANDXMIN := ORD(STFIL)-10;}
  250.           if DIRECT = 1 then XJMP := XJMP +3 else XJMP := XJMP -3;
  251.         end;
  252.       end;
  253.       DisplayIt;
  254.     Until KeyPressed;
  255.     WhatKey;
  256.   Until upCase(KEY)='Q';
  257.   close (FNM);
  258. end;
  259.  
  260. begin
  261.   ClrScr;
  262.   Init;
  263.   Entfile;
  264.   CloseGraph;
  265. end.