home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Billiards / billiard.p next >
Encoding:
Text File  |  1996-09-29  |  3.4 KB  |  153 lines  |  [TEXT/Rich]
  1. { Billiards Program Simulation - main program }
  2. { written by Tim Budd, Oregon State University }
  3. { April 1990 }
  4.  
  5. program billiards;
  6.  
  7.     uses
  8.         SimpleWindow, graphicUniverse, billiardComponents;
  9.     type
  10.             { the menu containing the quit command }
  11.         BilliardMenu = object(SimpleMenu)
  12.                 procedure initialize (title: STR255);
  13.                 procedure selectItem (itemNumber: Integer); override;
  14.             end;
  15.  
  16.             { the main simulation window }
  17.         BilliardSimulation = object(SimpleWindow)
  18.                 procedure initialize;
  19.                 procedure buttonDown (x, y: integer); override;
  20.                 procedure update; override;
  21.                 procedure keyPressed (c: char); override;
  22.                 procedure createWalls;
  23.                 procedure createHoles;
  24.                 procedure rackBalls;
  25.             end;
  26.     var
  27.         theGame: BilliardSimulation;
  28.  
  29.     { create a new menu }
  30.     procedure BilliardMenu.initialize (title: Str255);
  31.     begin
  32.         self.createNewMenu(title);
  33.         self.addItem('quit');
  34.     end;
  35.  
  36.     { when the user selects quit, we quit }
  37.     procedure BilliardMenu.selectItem (itemNumber: integer);
  38.     begin
  39.         theGame.endEventLoop;
  40.     end;
  41.  
  42.     { initialize the billiard window }
  43.     procedure BilliardSimulation.initialize;
  44.         var
  45.             appleMenu: SimpleMenu;
  46.             newMenu: BilliardMenu;
  47.     begin
  48.         setAttributes;
  49.         name := 'billiard Simulation';
  50.         setRect(windowRect, 20, 50, 400, 350);
  51.  
  52.         new(theUniverse);
  53.         theUniverse.initialize;
  54.  
  55.         createWalls;
  56.         createHoles;
  57.         rackBalls;
  58.  
  59.         new(appleMenu);
  60.         appleMenu.createAppleMenu('about BilliardSimulation...');
  61.  
  62.         new(newMenu);
  63.         newMenu.initialize('billiards');
  64.  
  65.         establish;
  66.     end;
  67.  
  68.     { when the button goes down, it the cue ball }
  69.     procedure BilliardSimulation.buttonDown (x, y: integer);
  70.     begin
  71.         cueBall.energy := 20.0;
  72.         cueBall.direction := hitAngle(cueBall.x - x, cueBall.y - y);
  73.         theUniverse.updateMoveableObjects;
  74.     end;
  75.  
  76.     { to update the simulation, draw everything }
  77.     procedure BilliardSimulation.update;
  78.     begin
  79.         inherited update;
  80.         theUniverse.draw;
  81.     end;
  82.  
  83.     procedure BilliardSimulation.createWalls;
  84.         var
  85.             newWall: wall;
  86.     begin
  87.         new(newWall);
  88.         newWall.setBounds(10, 10, 300, 15, 0.0);
  89.         theUniverse.installFixedObject(newWall);
  90.         new(newWall);
  91.         newWall.setBounds(10, 200, 300, 205, 0.0);
  92.         theUniverse.installFixedObject(newWall);
  93.         new(newWall);
  94.         newWall.setBounds(10, 10, 15, 200, 3.114159);
  95.         theUniverse.installFixedObject(newWall);
  96.         new(newWall);
  97.         newWall.setBounds(300, 10, 305, 205, 3.114159);
  98.         theUniverse.installFixedObject(newWall);
  99.     end;
  100.  
  101.     procedure BilliardSimulation.createHoles;
  102.         var
  103.             newHole: hole;
  104.     begin
  105.         new(newHole);
  106.         newHole.setCenter(15, 15);
  107.         theUniverse.installFixedObject(newHole);
  108.         new(newHole);
  109.         newHole.setCenter(15, 200);
  110.         theUniverse.installFixedObject(newHole);
  111.         new(newHole);
  112.         newHole.setCenter(300, 15);
  113.         theUniverse.installFixedObject(newHole);
  114.         new(newHole);
  115.         newHole.setCenter(300, 200);
  116.         theUniverse.installFixedObject(newHole);
  117.     end;
  118.  
  119.     procedure BilliardSimulation.rackBalls;
  120.         var
  121.             i, j: integer;
  122.             newBall: ball;
  123.     begin
  124.         saveRack := 0;
  125.         new(cueBall);
  126.         cueBall.setCenter(50, 96);
  127.         cueBall.direction := 0.0;
  128.         theUniverse.installMovableObject(cueBall);
  129.  
  130.         for i := 1 to 5 do
  131.             for j := 1 to i do
  132.                 begin
  133.                     new(newBall);
  134.                     newBall.setCenter(190 + i * 8, 100 + 16 * j - 8 * i);
  135.                     theUniverse.installMovableObject(newBall);
  136.                 end;
  137.     end;
  138.  
  139.     { quit on any key press }
  140.     procedure BilliardSimulation.keyPressed (c: char);
  141.     begin
  142.         endEventLoop;
  143.     end;
  144.  
  145. { ********** main program ********* }
  146. begin
  147.     globalInitializations;
  148.  
  149.     new(theGame);
  150.     theGame.initialize;
  151.     theGame.eventLoop;
  152. end.
  153.