home *** CD-ROM | disk | FTP | other *** search
/ Sound Sensations! / sound_sensations.iso / miscprog / mfiddle / mfiddle.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-07  |  5.0 KB  |  152 lines
  1. { *********************************** }
  2. {  A Program to tune your fiddle.     }
  3. {  by Stephen H. Tuell                }
  4. {     Kaneohe, Hawaii                 }
  5. {     February  1990                  }
  6. { *********************************** }
  7.  
  8. Program Mfiddle;
  9. uses
  10.   Crt, Dos, Graph,mousu;
  11. const WIDTH = 20 ;  { Line +/- WIDTH pixels will activate tone. }
  12. var
  13.   GraphDriver : integer;  { The Graphics device driver }
  14.   GraphMode   : integer;  { The Graphics mode value }
  15.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  16.   ErrorCode   : integer;  { Reports any graphics errors }
  17.   MaxColor    : word;     { The maximum color value available }
  18.   OldExitProc : Pointer;  { Saves exit procedure address }
  19.  
  20. { Initialize graphics and report any errors that may occur }
  21. procedure Initialize;
  22. var
  23.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  24.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  25. begin
  26.   { When using Crt and graphics, turn off Crt's memory-mapped writes }
  27.   DirectVideo := FALSE;
  28.   PathToDriver := '';
  29.   repeat
  30. {$IFDEF Use8514}                          { check for Use8514 $DEFINE }
  31.     GraphDriver := IBM8514;
  32.     GraphMode := IBM8514Hi;
  33. {$ELSE}
  34.     GraphDriver := Detect;                { use autodetection }
  35. {$ENDIF}
  36.  
  37.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  38.     ErrorCode := GraphResult;             { preserve error return }
  39.     if ErrorCode <> grOK then             { error? }
  40.     begin
  41.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  42.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  43.       begin
  44.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  45.         Readln(PathToDriver);
  46.         Writeln;
  47.       end
  48.       else
  49.         Halt(1);                          { Some other error: terminate }
  50.     end;
  51.   until ErrorCode = grOK;
  52.   Randomize;                { Init random number generator }
  53.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  54.   MaxX := GetMaxX;          { Get screen resolution values }
  55.   MaxY := GetMaxY;
  56. end; { Initialize }
  57.  
  58. { Abort with message if no mouse driver present }
  59. Procedure DetectMouse;
  60. Begin
  61.  ClrScr;
  62.  ResetMouse;
  63.  If NOT MousePresent then
  64.    Begin
  65.     WriteLn('Mouse driver not present.');
  66.     WriteLn('Terminating program.');
  67.     Halt;
  68.    End;
  69.  ClrScr;
  70. End;
  71.  
  72. { Converts an integer to a string for use with OutText, OutTextXY }
  73. function Int2Str(L : LongInt) : string;
  74. var
  75.   S : string;
  76. begin
  77.   Str(L, S);
  78.   Int2Str := S;
  79. end; { Int2Str }
  80.  
  81. { This function returns true if mouse is within the rectangle defined by
  82.   x1,y1,x2,y2 }
  83. Function mouseinside(x1,y1,x2,y2:word):Boolean;
  84. begin
  85.  GetButtonStatus;
  86.  mouseinside:=(mousex>=x1) AND (mousex <=X2) AND (Mousey>=y1) AND (Mousey<=y2);
  87. end;
  88.  
  89. { This function returns true if mouse is within XWIDTH pixels of xposition X
  90.                         AND     mouse is within YWIDTH pixels of yposition Y}
  91. Function mousenear(x,xwidth,y,ywidth:word):Boolean;
  92. begin
  93.     GetButtonStatus;
  94.     Mousenear:=(mousex>=(x-xwidth)) AND (mousex <=(x+xwidth))
  95.        AND     (mousey>=(y-ywidth)) AND (mousey <=(y+ywidth)) ;
  96. end;
  97.  
  98. Begin
  99.        Nosound;
  100. { If no mouse driver installed, abort program with error message. }
  101.        Detectmouse;
  102. { Initialize graphics }
  103.        Initialize;
  104.        setBkColor(BLUE);
  105.        setColor(YELLOW);
  106. { Initialize mouse driver }
  107.        resetmouse;
  108.        SetGraphicsCursor(PointingHandCurs);
  109. { Make Quit box }
  110.        Rectangle(450,100,549,120);
  111.        SetFillStyle(SolidFill,Red);
  112.        FloodFill(451,101,Yellow);
  113.        SetTextStyle(TriplexFont,HorizDir,1);
  114.        outtextxy(481,100,'QUIT');
  115. { Put up Program Boiler Plate }
  116.        SetTextStyle(SansSerifFont,HorizDir,4);
  117.        SetlineStyle(SolidLn,0,ThickWidth);
  118.        Setcolor(Brown);
  119.        Line(410,45,600,45);
  120.        SetfillStyle(SolidFill,Green);
  121.        bar3d(420,265,600,395,20,TRUE);
  122.        Setcolor(White);
  123.        Outtextxy(430,280,'Use Mouse ');
  124.        Outtextxy(430,310,'to select');
  125.        Outtextxy(430,340,'a string.');
  126.        SetFillStyle(SolidFill,Red);
  127.        outtextxy(410,10,'Fiddle Tuner');
  128. { Draw the strings }
  129.        Setcolor(yellow);
  130.        line(70,50,70,400);
  131.        line(170,50,170,400);
  132.        line(270,50,270,400);
  133.        line(370,50,370,400);
  134. { Label the strings }
  135.        SetTextStyle(TriplexFont,HorizDir,4);
  136.        outtextxy( 60,415,'G');
  137.        outtextxy(160,415,'D');
  138.        outtextxy(260,415,'A');
  139.        outtextxy(360,415,'E');
  140. { Poll the strings and play the notes }
  141.    SetMouseCursorPos(580,315);
  142.    ShowMouseCursor;
  143.    Repeat
  144.      if      mousenear(70,WIDTH,225,175) then sound(196)
  145.       else if mousenear(170,WIDTH,225,175) then sound(294)
  146.        else if mousenear(270,WIDTH,225,175) then sound(440)
  147.         else if mousenear(370,WIDTH,225,175) then sound(659)
  148.          else nosound;
  149.    until mouseinside(450,100,549,120) ;  { Quit if in the Quit Box }
  150.    nosound;  { Turn off the sound }
  151.    textmode(2);
  152. end.