#!/bin/sh
echo 'Start of billiard, part 01 of 01:'
echo 'x - billiard.p'
sed 's/^X//' > billiard.p << '/'
X{ Billiards Program Simulation - main program }
X{ written by Tim Budd, Oregon State University }
X{ April 1990 }
X
Xprogram billiards;
X
X	uses
X		SimpleWindow, graphicUniverse, billiardComponents;
X	type
X			{ the menu containing the quit command }
X		BilliardMenu = object(SimpleMenu)
X				procedure initialize (title: STR255);
X				procedure selectItem (itemNumber: Integer); override;
X			end;
X
X			{ the main simulation window }
X		BilliardSimulation = object(SimpleWindow)
X				procedure initialize;
X				procedure buttonDown (x, y: integer); override;
X				procedure update; override;
X				procedure keyPressed (c: char); override;
X				procedure createWalls;
X				procedure createHoles;
X				procedure rackBalls;
X			end;
X	var
X		theGame: BilliardSimulation;
X
X	{ create a new menu }
X	procedure BilliardMenu.initialize (title: Str255);
X	begin
X		self.createNewMenu(title);
X		self.addItem('quit');
X	end;
X
X	{ when the user selects quit, we quit }
X	procedure BilliardMenu.selectItem (itemNumber: integer);
X	begin
X		theGame.endEventLoop;
X	end;
X
X	{ initialize the billiard window }
X	procedure BilliardSimulation.initialize;
X		var
X			appleMenu: SimpleMenu;
X			newMenu: BilliardMenu;
X	begin
X		setAttributes;
X		name := 'billiard Simulation';
X		setRect(windowRect, 20, 50, 400, 350);
X
X		new(theUniverse);
X		theUniverse.initialize;
X
X		createWalls;
X		createHoles;
X		rackBalls;
X
X		new(appleMenu);
X		appleMenu.createAppleMenu('about BilliardSimulation...');
X
X		new(newMenu);
X		newMenu.initialize('billiards');
X
X		establish;
X	end;
X
X	{ when the button goes down, it the cue ball }
X	procedure BilliardSimulation.buttonDown (x, y: integer);
X	begin
X		cueBall.energy := 20.0;
X		cueBall.direction := hitAngle(cueBall.x - x, cueBall.y - y);
X		theUniverse.updateMoveableObjects;
X	end;
X
X	{ to update the simulation, draw everything }
X	procedure BilliardSimulation.update;
X	begin
X		inherited update;
X		theUniverse.draw;
X	end;
X
X	procedure BilliardSimulation.createWalls;
X		var
X			newWall: wall;
X	begin
X		new(newWall);
X		newWall.setBounds(10, 10, 300, 15, 0.0);
X		theUniverse.installFixedObject(newWall);
X		new(newWall);
X		newWall.setBounds(10, 200, 300, 205, 0.0);
X		theUniverse.installFixedObject(newWall);
X		new(newWall);
X		newWall.setBounds(10, 10, 15, 200, 3.14159);
X		theUniverse.installFixedObject(newWall);
X		new(newWall);
X		newWall.setBounds(300, 10, 305, 205, 3.14159);
X		theUniverse.installFixedObject(newWall);
X	end;
X
X	procedure BilliardSimulation.createHoles;
X		var
X			newHole: hole;
X	begin
X		new(newHole);
X		newHole.setCenter(15, 15);
X		theUniverse.installFixedObject(newHole);
X		new(newHole);
X		newHole.setCenter(15, 200);
X		theUniverse.installFixedObject(newHole);
X		new(newHole);
X		newHole.setCenter(300, 15);
X		theUniverse.installFixedObject(newHole);
X		new(newHole);
X		newHole.setCenter(300, 200);
X		theUniverse.installFixedObject(newHole);
X	end;
X
X	procedure BilliardSimulation.rackBalls;
X		var
X			i, j: integer;
X			newBall: ball;
X	begin
X		saveRack := 0;
X		new(cueBall);
X		cueBall.setCenter(50, 96);
X		cueBall.direction := 0.0;
X		theUniverse.installMovableObject(cueBall);
X
X		for i := 1 to 5 do
X			for j := 1 to i do
X				begin
X					new(newBall);
X					newBall.setCenter(190 + i * 8, 100 + 16 * j - 8 * i);
X					theUniverse.installMovableObject(newBall);
X				end;
X	end;
X
X	{ quit on any key press }
X	procedure BilliardSimulation.keyPressed (c: char);
X	begin
X		endEventLoop;
X	end;
X
X{ ********** main program ********* }
Xbegin
X	globalInitializations;
X
X	new(theGame);
X	theGame.initialize;
X	theGame.eventLoop;
Xend.
/
echo 'x - components.p'
sed 's/^X//' > components.p << '/'
X{ components for billiard simulation }
X{ written by Tim Budd, Oregon State University }
X{ April 1990 }
X
Xunit billiardComponents;
Xinterface
X	uses
X		graphicUniverse;
X
X	type
X
X		wall = object(GraphicalObject)
X				convertFactor: real;
X				procedure setBounds (left, top, right, bottom: integer; cf: real);
X				procedure draw; override;
X				procedure hitBy (anObject: GraphicalObject); override;
X			end;
X
X		hole = object(GraphicalObject)
X				procedure setCenter (x, y: integer);
X				procedure draw; override;
X				procedure hitBy (anObject: GraphicalObject); override;
X			end;
X
X		ball = object(hole)
X				direction: real;
X				energy: real;
X				procedure draw; override;
X				procedure update; override;
X				procedure hitBy (anObject: GraphicalObject); override;
X				function x: real;
X				function y: real;
X			end;
X
X	var
X		theUniverse: ObjectUniverse;
X		cueBall: ball;
X		saveRack: integer;
X
X	function hitAngle (dx, dy: real): real;
X
Ximplementation
X
X	function hitAngle (dx, dy: real): real;
X		const
X			PI = 3.14159;
X		var
X			na: real;
X	begin
X		if (abs(dx) < 0.05) then
X			na := PI / 2
X		else
X			na := arctan(abs(dy / dx));
X		if (dx < 0) then
X			na := PI - na;
X		if (dy < 0) then
X			na := -na;
X		hitAngle := na;
X	end;
X
X	procedure wall.setBounds (left, top, right, bottom: integer; cf: real);
X	begin
X		convertFactor := cf;
X		SetRect(region, left, top, right, bottom);
X	end;
X
X	procedure wall.draw;
X	begin
X		PaintRect(region);
X	end;
X
X	procedure wall.hitBy (anObject: GraphicalObject);
X		var
X			theBall: ball;
X	begin
X		theBall := ball(anObject);
X		theBall.direction := convertFactor - theBall.direction;
X		theUniverse.continueSimulation;
X		draw;
X	end;
X
X	procedure hole.setCenter (x, y: integer);
X	begin
X		SetRect(region, x - 5, y - 5, x + 5, y + 5);
X	end;
X
X	procedure hole.draw;
X	begin
X		PaintOval(region);
X	end;
X
X	procedure hole.hitBy (anObject: GraphicalObject);
X		var
X			theBall: ball;
X	begin
X		theBall := ball(anObject);
X		if (theBall = cueBall) then
X			theBall.setCenter(50, 100)
X		else
X			begin
X				saveRack := saveRack + 1;
X				theBall.setCenter(10 + saveRack * 15, 250);
X			end;
X		theBall.energy := 0.0;
X		anObject.draw;
X	end;
X
X	function ball.x: real;
X	begin
X		x := (region.left + region.right) / 2;
X	end;
X
X	function ball.y: real;
X	begin
X		y := (region.top + region.bottom) / 2;
X	end;
X
X
X	procedure ball.draw;
X	begin
X		if (self = cueBall) then
X			FrameOval(region)
X		else
X			PaintOval(region);
X	end;
X
X	procedure ball.update;
X		var
X			hit: GraphicalObject;
X			dx, dy: integer;
X			i, xdir, ydir, ymove: integer;
X	begin
X		if (energy > 0.5) then
X			begin
X				erase;
X				energy := energy - 0.05;
X				if energy > 0.5 then
X					theUniverse.continueSimulation;
X				dx := trunc(5.0 * cos(direction));
X				dy := trunc(5.0 * sin(direction));
X				offsetRect(region, dx, dy);
X				hit := theUniverse.hitObject(self);
X				if hit <> nil then
X					begin
X						hit.hitBy(self);
X						theUniverse.draw;
X					end
X				else
X					draw;
X			end;
X	end;
X
X	procedure ball.hitBy (anObject: GraphicalObject);
X		var
X			aBall: ball;
X			da: real;
X	begin
X		aBall := ball(anObject);
X		energy := aBall.energy / 2;
X		aBall.energy := energy;
X		direction := hitAngle(self.x - aBall.x, self.y - aBall.y);
X		da := aBall.direction - direction;
X		aBall.direction := aBall.direction + da;
X		theUniverse.continueSimulation;
X	end;
Xend.
/
echo 'x - graph.p'
sed 's/^X//' > graph.p << '/'
X{ graphical simulation class }
X{ written by Tim Budd, Oregon State University }
X{ April 1990 }
X
Xunit graphicUniverse;
X
Xinterface
X
X	type
X
X		GraphicalObject = object
X				link: GraphicalObject;
X				region: Rect;
X				procedure moveTo (x, y: integer);
X				function intersectsWith (anObject: GraphicalObject): boolean;
X				procedure erase;
X					{ the following overridden in subclasses }
X				procedure update;
X				procedure draw;
X				procedure hitBy (anObject: GraphicalObject);
X			end;
X
X		ObjectUniverse = object
X				moveableObjects: GraphicalObject;
X				fixedObjects: GraphicalObject;
X				continueUpdate: boolean;
X				procedure initialize;
X				procedure installFixedObject (newObj: GraphicalObject);
X				procedure installMovableObject (newObj: GraphicalObject);
X				procedure draw;
X				procedure updateMoveableObjects;
X				procedure continueSimulation;
X				function hitObject (anObject: GraphicalObject):GraphicalObject;
X			end;
X
Ximplementation
X
X	procedure GraphicalObject.moveTo (x, y: integer);
X	begin
X		OffsetRect(region, region.top, region.left);
X		OffsetRect(region, x, y);
X	end;
X
X	procedure GraphicalObject.update;
X	begin
X		{ implemented in subclass }
X	end;
X
X	procedure GraphicalObject.erase;
X	begin
X		EraseRect(region);
X	end;
X
X	procedure GraphicalObject.draw;
X	begin
X		{ implemented in subclass }
X	end;
X
X	function GraphicalObject.intersectsWith (anObject: GraphicalObject): 
X				boolean;
X		var
X			theIntersection: Rect;
X	begin
X		intersectsWith := SectRect(region, anObject.region, theIntersection);
X	end;
X
X	procedure GraphicalObject.hitBy (anObject: GraphicalObject);
X	begin
X		{ behavior provided by subclass }
X	end;
X
X	procedure ObjectUniverse.initialize;
X	begin
X		fixedObjects := nil;
X		moveableObjects := nil;
X	end;
X
X	procedure ObjectUniverse.installFixedObject (newObj: GraphicalObject);
X	begin
X		newObj.link := fixedObjects;
X		fixedObjects := newObj;
X	end;
X
X	procedure ObjectUniverse.installMovableObject;
X	begin
X		newObj.link := moveableObjects;
X		moveableObjects := newObj;
X	end;
X
X	procedure ObjectUniverse.updateMoveableObjects;
X		var
X			currentObject: GraphicalObject;
X	begin
X		repeat
X			continueUpdate := false;
X			currentObject := moveableObjects;
X			while currentObject <> nil do
X				begin
X					currentObject.update;
X					currentObject := currentObject.link;
X				end;
X		until not continueUpdate
X	end;
X
X	procedure ObjectUniverse.continueSimulation;
X	begin
X		continueUpdate := true
X	end;
X
X	procedure ObjectUniverse.draw;
X		var
X			currentObject: GraphicalObject;
X	begin
X		currentObject := fixedObjects;
X		while currentObject <> nil do
X			begin
X				currentObject.draw;
X				currentObject := currentObject.link;
X			end;
X		currentObject := moveableObjects;
X		while currentObject <> nil do
X			begin
X				currentObject.draw;
X				currentObject := currentObject.link;
X			end;
X	end;
X
X	function ObjectUniverse.hitObject (anObject: GraphicalObject): 
X				GraphicalObject;
X		var
X			currentObject: GraphicalObject;
X			hit: GraphicalObject;
X	begin
X		currentObject := fixedObjects;
X		hit := nil;
X		while (hit = nil) and (currentObject <> nil) do
X			begin
X				if (anObject <> currentObject) then
X					if (anObject.intersectsWith(currentObject)) then
X						hit := currentObject;
X				currentObject := currentObject.link;
X			end;
X		currentObject := moveableObjects;
X		while (hit = nil) and (currentObject <> nil) do
X			begin
X				if (anObject <> currentObject) then
X					if (anObject.intersectsWith(currentObject)) then
X						hit := currentObject;
X				currentObject := currentObject.link;
X			end;
X		hitObject := hit;
X	end;
Xend.
/
echo 'x - simplewindow.p'
sed 's/^X//' > simplewindow.p << '/'
X{ simple window interface for Object Pascal }
X{ written by Tim Budd, Oregon State University }
X{ April 1990 }
X
Xunit SimpleWindow;
X
Xinterface
X
X	type
X		SimpleMenu = object
X					{ data fields }
X				theMenuID: Integer;
X				theMenuPtr: MenuHandle;
X				link: SimpleMenu;
X					{ creation methods }
X				procedure readFromResource (id: integer);
X				procedure createNewMenu (title: Str255);
X				procedure createAppleMenu (aboutTitle: Str255);
X					{ adding elements to menu }
X				procedure addItem (title: Str255);
X				procedure addSeparator;
X					{ action to take when selected }
X					{ must be overridden by user }
X				procedure selectItem (itemNumber: integer);
X			end;
X
X		SimpleWindow = object
X					{ data fields }
X				theWindowPtr: windowPtr;
X				name: STR255;
X				windowRect: Rect;
X				winType: integer;
X				done: boolean;
X				event: eventRecord;
X					{ creation methods }
X				procedure setAttributes;
X				procedure establish;
X					{ event handling }
X				procedure eventLoop;
X				procedure eventLoopTask;
X				procedure endEventLoop;
X					{ window events - seldom overridden }
X				procedure activate;
X				procedure deactivate;
X				procedure menu (which: LongInt);
X				procedure menuChoice (theMenu, theItem: integer);
X				procedure buttonDownEvent;
X				procedure keyEvent;
X				procedure handleDrag;
X				procedure handleGrow;
X				procedure doGoAway;
X					{ window events - often overridden }
X				procedure buttonDown (x, y: integer);
X				procedure keyPressed (c: char);
X				procedure update;
X			end;
X	var
X		nextMenuID: Integer;
X		globalMenuList: SimpleMenu;
X
X	procedure setNextMenuID (id: integer);
X	procedure globalInitializations;
X
Ximplementation
X
X	{ the necessary Macintosh initializations }
X	procedure globalInitializations;
X	begin
X		initGraf(@ThePort);
X		InitFonts;
X		InitWindows;
X		FlushEvents(everyEvent, 0);
X		InitMenus;
X		DrawMenuBar;
X		TEInit;
X		InitDialogs(nil);
X		initCursor;
X		nextMenuID := 512;
X		globalMenuList := nil;
X	end;
X
X	{ set the attributes on the simple window }
X	procedure SimpleWindow.setAttributes;
X	begin
X		name := 'unknown window';
X		SetRect(windowRect, 50, 70, 350, 270);
X		winType := DocumentProc;
X		done := false;
X	end;
X
X	{ open (establish) a simple window }
X	procedure SimpleWindow.establish;
X		var
X			tempPort: Grafptr;
X	begin
X		GetPort(tempPort);
X		theWindowPtr := NewWindow(nil, windowRect, name, 
X			TRUE, winType, WindowPtr(-1), TRUE, LongInt(0));
X		SelectWindow(theWindowPtr);
X		ShowWindow(theWindowPtr);
X	end;
X
X	{ start up a main event loop }
X	procedure SimpleWindow.eventLoop;
X	begin
X		while not done do
X			self.eventLoopTask;
X	end;
X
X	procedure SimpleWindow.eventLoopTask;
X		var
X			ignore: boolean;
X	begin
X		systemTask;
X		ignore := GetNextEvent(everyEvent, event);
X
X		case event.what of
X
X			mouseDown: 
X				self.buttonDownEvent;
X
X			keyDown: 
X				self.keyEvent;
X
X			activateEvt: 
X				if BitAnd(event.modifiers, activeFlag) <> 0 then
X					self.activate
X				else
X					self.deactivate;
X
X			updateEvt: 
X				self.update;
X
X			otherwise
X				;
X		end;
X	end;
X
X	procedure SimpleWindow.endEventLoop;
X	begin
X		done := true
X	end;
X
X	procedure SimpleWindow.buttonDownEvent;
X		var
X			localPoint: Point;
X			wp: WindowPtr;
X	begin
X		case FindWindow(event.where, wp) of
X
X			inSysWindow: 
X				SystemClick(event, wp);
X
X			inMenuBar: 
X				self.menu(menuSelect(event.where));
X
X			inGrow: 
X				self.handleGrow;
X
X			inDrag: 
X				self.handleDrag;
X
X			inContent: 
X				if wp <> FrontWindow then
X					SelectWindow(wp)
X				else
X					begin
X						localPoint := event.where;
X						GlobalToLocal(localPoint);
X						self.buttonDown(localPoint.h, localPoint.v);
X					end;
X
X			inGoAway: 
X				self.doGoAway;
X
X		end;
X	end;
X
X	procedure SimpleWindow.keyEvent;
X		var
X			chCode: integer;
X			ch: char;
X	begin
X		chCode := BitAnd(event.message, CharCodeMask);
X		ch := chr(chCode);
X		if BitAnd(event.modifiers, CmdKey) <> 0 then
X			begin
X				if event.what <> AutoKey then
X					self.menu(MenuKey(ch))
X			end
X		else
X			self.keyPressed(ch);
X	end;
X
X	{ handle a conventional key press - overridden in subclasses }
X	procedure SimpleWindow.keyPressed (c: char);
X	begin
X	end;
X
X	{ handle a window activation }
X	procedure SimpleWindow.activate;
X	begin
X		SetPort(self.theWindowPtr);
X	end;
X
X	procedure SimpleWindow.deactivate;
X	begin
X		{ subclasses may do something, we don't }
X	end;
X
X	procedure SimpleWindow.menu (which: LongInt);
X		var
X			theMenu, theItem: integer;
X	begin
X		if which <> 0 then
X			self.menuChoice(HiWord(which), LoWord(which));
X	end;
X
X	procedure SimpleWindow.handleDrag;
X	begin
X		dragWindow(theWindowPtr, event.where, ScreenBits.bounds);
X	end;
X
X	procedure SimpleWindow.handleGrow;
X	begin
X		{ assumption is that windows can't grow  }
X		{ can be overridden in subclasses }
X	end;
X
X	{ handle a menu selection }
X	procedure SimpleWindow.menuChoice (theMenu, theItem: Integer);
X		var
X			menuPtr: SimpleMenu;
X	begin
X		menuPtr := globalMenuList;
X		while menuPtr <> nil do
X			if menuPtr.theMenuID = theMenu then
X				begin
X					menuPtr.selectItem(theItem);
X					menuPtr := nil
X				end
X			else
X				menuPtr := menuPTr.link;
X	end;
X
X	{ handle a window update - usually modified in subclasses }
X	procedure SimpleWindow.update;
X	begin
X		SetPort(self.theWindowPtr);
X		ClipRect(self.theWindowPtr^.portRect);
X	end;
X
X	{ handle a button down event - usually overridden in subclasses}
X	procedure SimpleWindow.buttonDown (x, y: integer);
X	begin
X	end;
X
X	{ handle button press in go away box }
X	procedure SimpleWindow.doGoAway;
X	begin
X	end;
X
X	{ insert a menu into the menu bar }
X	procedure insertAndDraw (menu: SimpleMenu);
X	begin
X		InsertMenu(menu.theMenuPtr, 0);
X		DrawMenuBar;
X		menu.link := globalMenuList;
X		globalMenuList := menu;
X	end;
X
X	{ read a menu description from resource file }
X	procedure SimpleMenu.readFromResource (id: integer);
X	begin
X		theMenuPtr := GetMenu(id);
X		theMenuID := id;
X		insertAndDraw(self);
X	end;
X
X	{ create a new menu }
X	procedure SimpleMenu.createNewMenu (title: Str255);
X	begin
X		theMenuID := nextMenuID;
X		nextMenuID := nextMenuID + 1;
X		theMenuPtr := NewMenu(theMenuID, title);
X		InsertAndDraw(self);
X	end;
X
X	{ create the special Apple menu item }
X	procedure SimpleMenu.createAppleMenu (aboutTitle: Str255);
X		var
X			appleTitle: Str255;
X	begin
X		appleTitle := '@';
X		appleTitle[1] := CHR(AppleMark);
X		self.createNewMenu(appleTitle);
X		self.addItem(aboutTitle);
X		self.addSeparator;
X		AddResMenu(theMenuPtr, 'DRVR');
X	end;
X
X	{ add an item to a menu }
X	procedure SimpleMenu.addItem (title: Str255);
X	begin
X		AppendMenu(theMenuPtr, title);
X	end;
X
X	{ add a separator bar to a menu }
X	procedure SimpleMenu.addSeparator;
X	begin
X		self.addItem('(-----------------');
X	end;
X
X	procedure SimpleMenu.selectItem (itemNumber: integer);
X		var
X			accName: Str255;
X			accNumber: Integer;
X	begin
X	{ this is just to handle the Apple menu }
X	{ should be overridden in all other subclasses }
X		if itemNumber > 1 then
X			begin
X				GetItem(self.theMenuPtr, itemNumber, accName);
X				accNumber := OpenDeskAcc(accName);
X			end;
X	end;
Xend.
/
echo 'Part 01 of billiard complete.'
exit