MiniPascal Supplement

A Nudge Command

Procedure NudgeObj;
VAR
	nudgeDist,nudgeDistHalf,X1,Y1,MouseX,MouseY : REAL;
	ObHd1: HANDLE;
	KCod : INTEGER;
BEGIN
	nudgeDist:=Abs(DistDialog('Enter movement distance:','0'));
	nudgeDistHalf:=nudgeDist/2;
	IF NOT DidCancel THEN BEGIN
	ObHd1:=FSActLayer;
	IF ObHd1 <> NIL THEN BEGIN
		SetSelect(ObHd1);
		Redraw;
		WHILE (KCod<>13) DO BEGIN {- until return is pressed -}
			IF MouseDown(MouseX,MouseY) THEN SysBeep;{-handles mouse downs-}
			IF KeyDown(KCod) THEN BEGIN
				IF KCod = 50 THEN BEGIN {- '2' key -}
					IF Shift THEN HMove(ObHd1,0,-nudgeDistHalf);
					IF NOT Shift THEN HMove(ObHd1,0,-nudgeDist);
					Redraw;
				END
				ELSE IF KCod = 56 THEN BEGIN {- '8' key -}
					IF Shift THEN HMove(ObHd1,0,nudgeDistHalf);
					IF NOT Shift THEN HMove(ObHd1,0,nudgeDist);
					Redraw;
					END
				ELSE IF KCod = 54 THEN BEGIN {- '6' key -}
					IF Shift THEN HMove(ObHd1,nudgeDistHalf,0);
					IF NOT Shift THEN HMove(ObHd1,nudgeDist,0);
					Redraw;
				END
				ELSE IF KCod = 52 THEN BEGIN {- '4' key -}
					IF Shift THEN HMove(ObHd1,-nudgeDistHalf,0);
					IF NOT Shift THEN HMove(ObHd1,-nudgeDist,0);
					Redraw;
				END
				ELSE IF KCod = 57 THEN BEGIN {- '9' key -}
					IF Shift THEN HMove(ObHd1,nudgeDistHalf,nudgeDistHalf);
					IF NOT Shift THEN HMove(ObHd1,nudgeDist,nudgeDist);
					Redraw;
				END
				ELSE IF KCod = 55 THEN BEGIN {- '7' key -}
					IF Shift THEN HMove(ObHd1,-nudgeDistHalf,nudgeDistHalf);
					IF NOT Shift THEN HMove(ObHd1,-nudgeDist,nudgeDist);
					Redraw;
				END
				ELSE IF KCod = 51 THEN BEGIN {- '3' key -}
					IF Shift THEN HMove(ObHd1,nudgeDistHalf,-nudgeDistHalf);
					IF NOT Shift THEN HMove(ObHd1,nudgeDist,-nudgeDist);
					Redraw;
				END
				ELSE IF KCod = 49 THEN BEGIN {- '1' key -}
					IF Shift THEN HMove(ObHd1,-nudgeDistHalf,-nudgeDistHalf);
					IF NOT Shift THEN HMove(ObHd1,-nudgeDist,-nudgeDist);
					Redraw;
				END
				ELSE IF KCod = 53 THEN BEGIN {- '5' key -}
					IF Shift THEN Rotate(22.5d);
					IF NOT Shift THEN Rotate(45d);
					Redraw;
				END;
			END;
		END;
	END;
	
	SetDSelect(ObHd1);
	END;
	KCod:=0;
	END;
Run(NudgeObj);

What it does
Allows you to 'nudge' and rotate objects.

Description
The macro makes use of your keyboard input to move and rotate the selected objects. After specifying the nudge increment, a loop is entered which waits for keyboard input. When a key is pressed, the macro uses the key code to branch to the appropriate action. Depressing the shift key will halve the distance moved or rotated. On press of the Return key, the loop is exited and the macro terminates execution.

Creating a Room Parametrically

Procedure MakeRoom;
VAR
	Click1X,Click1Y,Click2X,Click2Y,Wall1Len,Wall2Len,BaseZ,Ht:REAL;
BEGIN
	{SetWallWidth(8");}
	GetZVals(BaseZ,Ht);
	IF Ht< 8' THEN SetZVals(BaseZ,8');
	
	GetRect(Click1X,Click1Y,Click2X,Click2Y);
	
	MoveTo(Click1X,Click1Y);
	WallTo(Click2X,Click1Y);
	Wall1Len:=Distance(Click1X,Click1Y,Click2X,Click1Y);
	IF (Wall1Len>48) THEN
		InsertSymbol(Wall1Len/2,0,FALSE,FALSE,FALSE,'3042DH');
		
	WallTo(Click2X,Click2Y);
	Wall2Len:=Distance(Click2X,Click1Y,Click2X,Click2Y);
	IF((Wall2Len>48)AND(Wall2Len<96)) THEN
		InsertSymbol(Wall2Len/2,0,FALSE,FALSE,FALSE,'3042DH')
	ELSE IF (Wall2Len>96) THEN BEGIN
		InsertSymbol(Wall2Len/4,0,FALSE,FALSE,FALSE,'3042DH');
		InsertSymbol(((Wall2Len/4)*3),0,FALSE,FALSE,FALSE,'3042DH');
	END;
	
	WallTo(Click1X,Click2Y);
	IF (Wall1Len>48) THEN
		InsertSymbol(Wall1Len/2,0,FALSE,FALSE,FALSE,'3042DH');
END;
Run(MakeRoom);

What it does
Creates a room whose 'attributes' are dependent on it's created size.

Description
The macro creates a room whose window configuration is based upon it's size when you define it. The macro uses a user defined rectangle, along with IF statements to determine whether windows should be placed within walls.

Creating A Mechanical Part Parametrically

Procedure DowelPin;
CONST
	chamSize=0.015;	{Used to determine size of chamfer}
	Theta=10;		{Chamfer angle}
	CF=0.25;		{Used to determine radius of rounded end}
VAR
	A,B,C,Diam,Length,adjustedLen,x0,y0 : REAL;
	View,RFlag : INTEGER;
	Abort : BOOLEAN;


{- Main Procedure -}
BEGIN
	DSelectAll;

	Diam:=RealDialog('Enter diameter of dowel pin','1/2"');
	IF NOT DidCancel THEN BEGIN
		Length:=RealDialog('Enter length of pin','1"');
			IF NOT DidCancel THEN BEGIN
			IF ((Length>0) AND (Diam>0)) THEN BEGIN
			GetPt(x0,y0);
			B:=Diam-chamSize;
			A:=chamSize/(2*Tan(Deg2Rad(Theta)));
			C:=CF*Diam;
			adjustedLen:=Length-A-C;
			ABSOLUTE;
			MoveTo(x0,y0);

			RELATIVE;
			Move(C,-Diam/2);
			ClosePoly;
			BeginPoly;
				LineTo(0,0);
				ArcTo(-C,0,C);
				ArcTo(0,Diam,C);
				LineTo(C,0);
			EndPoly;
			
			Rect(0,0,adjustedLen,-Diam);
			Move(adjustedLen,0);
			
			BeginPoly;
				LineTo(0,0);
				LineTo(A,-(Diam-B)/2);
		 		LineTo(0,-B);
				LineTo(-A,-(Diam-B)/2);
			EndPoly;
		
			Group;
		END
		ELSE
			AlrtDialog('Invalid value was entered');
		END;
		END;
	END;
END;

Run(DowelPin);

What it does
Creates a dowel pin according to your specifications.

Description
The macro generates a dowel pin according to your length and diameter specifications. Using commonly available formulas which define the size of standard mechanical parts, the dowel pin is generated using these formulas and drawn on screen.

Cataloging Symbols In A Document

Procedure CatSym;


Procedure TraverseSymbolList;
CONST
	kSTACKFULL=26;kSTACKEMPTY=0;
VAR
	hStack:ARRAY[1..25] OF HANDLE;
	i:INTEGER;
	
	Hd:HANDLE;
	Done,q:BOOLEAN;
	type:INTEGER;
	fn,fileNm:STRING;

Function Push(h:HANDLE):BOOLEAN;
BEGIN
	i:=i+1;
	
	IF i < kSTACKFULL THEN
	BEGIN
		hStack[i]:=h;
		Push:=TRUE;
	END
	ELSE
		Push:=FALSE;		
END;

Procedure Pop(VAR h:HANDLE);
VAR
	j:INTEGER;
BEGIN
	IF i<>kSTACKEMPTY THEN BEGIN
		j:=i;
		i:=i-1;
		h:=hStack[j];
		hStack[j]:=NIL;
	END;
END;

BEGIN
	i:=0;
	Done:=FALSE;
	
	fn:=GetFName;
	
	fn:=Concat(fn,' Symbol Report');
	PutFile('Save symbol report to:',fn,fileNm);
	Rewrite(fileNm);
	Writeln(fileNm);
	Writeln(Chr(128));
	Hd:=FSymDef;

	WHILE NOT Done DO BEGIN
		IF Hd <> NIL THEN BEGIN
			WHILE Hd<>NIL DO BEGIN
				IF GetType(Hd) = 11 THEN BEGIN
					Tab(i);
					WRITELN(GETNAME(Hd));
					q:=Push(Hd);
					Hd:=FInFolder(Hd);
				END
				ELSE IF GetType(Hd) = 16 THEN BEGIN
					Tab(i);
					WRITELN(GETSDNAME(Hd));
					Hd:=NextSymDef(Hd);

				END;
			END;
		END
		ELSE BEGIN
			IF i <> kSTACKEMPTY THEN BEGIN
				Pop(Hd);
				IF (GetType(Hd)=11) THEN
					Hd:=NextObj(Hd)
				ELSE
					Hd:=NextSymDef(Hd);

			END
			ELSE 
				Done:=TRUE;

		END;
	END;
	Close(fileNm);
END;
					
					
BEGIN
	TraverseSymbolList;
END;
Run(CatSym);

What it does
Generates a text file containing a list of all the symbols in a document.

Description
The macro traverses the entire symbol library of the document and creates a text file listing them. The macro implements a stack structure to descend into nested symbol folders and list the symbols found.

The macro currently will descend 25 folders DEEP(folder in folder,etc.) into a symbol library; by changing the size of the array, this can be modified if necessary. There is no limit to the total niumber of folders and/or symbols which can be processed.

Swap Symbols In A Wall

Procedure ExchSym;
VAR
	Hd:HANDLE;
	sym:STRING;
	oType:INTEGER;

{--subroutine SwapSymbolInWall }
Procedure SwapSymbolInWall(wallHd:HANDLE);
VAR
	oldSymHd,newSymHd:HANDLE;
	
{--subroutine TraverseWallSel }
Function TraverseWallSel(WallHd:HANDLE):HANDLE;
VAR
	Hd,aHd:HANDLE;
	Type:INTEGER;
	Nm:STRING;
	Sel,Hit,s:BOOLEAN;
BEGIN
	Hit:=FALSE;
	Hd:=FIn3D(WallHd);
	WHILE (Hd<>NIL) AND (NOT Hit) DO BEGIN
		Type:=GetType(Hd);
		IF Type = 15 THEN BEGIN
			s:=Selected(Hd);
			IF s THEN BEGIN
				aHd:=Hd;
				Hit:=True;
			END;
		END;
	Hd:=NextObj(Hd);
	END;
	
	TraverseWallSel:=aHd;
END;
{-- end TraverseWallSel }

BEGIN
	oldSymHd:=TraverseWallSel(wallHd);
	newSymHd:=ActSymDef;
	SetHDef(oldSymHd,newSymHd);
	HWallWidth(wallHd,WallWidth(wallHd));
END;

{--end SwapSymbolInWall }

BEGIN
	Hd:=FSActLayer;
	oType:=GetType(Hd);
	IF oType = 68 THEN BEGIN
	SwapSymbolInWall(Hd);
	END;
END;
Run(ExchSym);

What it does
Swaps the selected symbol in a wall for the active symbol of the document.

Description
The macro makes use of SetHDef() to swap the selected symbol in a wall for the active symbol. Nested subroutines are used to encapsulate the functionality of the wall entry and symbol swapping.

The function subroutine TraverseWallSel is used to 'enter' the wall object and process through it's component parts. When the selected symbol is found, the symbol is swapped using the function subroutine SwapSymbolInWall().

In the subroutine SwapSymbolInWall(), the call to SetWallWidth() after the SetHDef() call is used to force the wall to redraw properly.

Custom Dialog Example

Procedure Dessert;
VAR
	Abort,Cherry,Fudge,WCream,Cheez,spicySalsa:BOOLEAN;
	

{- this subroutine centers the dialog onscreen -}

Procedure AlignScreen(J,K: INTEGER; VAR TopL,BotR : INTEGER);
VAR
	scnx1,scny1,scnx2,scny2,Width : INTEGER;
BEGIN
	GetScreen(scnx1,scny1,scnx2,scny2);
	Width:= K-J;
	TopL:= ((scnx1 + scnx2) DIV 2) - (Width DIV 2);
	BotR:= TopL + Width;
END;


{ - the dialog definition - }

Procedure DefineDialog;
CONST
	SCW=340;SCH=232;
VAR
	TLeft,BRight:INTEGER;
BEGIN
	AlignScreen(0,SCW,TLeft,BRight);
	BeginDialog(1,1,TLeft,100,BRight,SCH);
	SetTitle('Dessert Toppings');
	AddButton('Yum!!',1,1,272,99,330,119);
	AddButton('No Thanks',2,1,180,99,262,119);
	AddButton('Whipped Cream',3,3,33,18,158,36);
	AddButton('Fudge Sauce',4,3,173,18,279,36);
	AddButton('Cheez Wiz',5,3,33,40,139,58);
	AddButton('Salsa, extra spicy',6,3,173,40,311,58);
	AddButton('With a cherry on top',7,2,43,70,230,88);
	EndDialog;
END;


{ - this function operates the dialog - }

Procedure DialogDriver(VAR Stop:BOOLEAN);
VAR
	Item:INTEGER;
	Done:BOOLEAN;
	
BEGIN
	DefineDialog;
	
	Done:=False;
	Stop:=False;
		
	GetDialog(1);
	SetItem(3,TRUE);
	
	REPEAT
		DialogEvent(Item);
		
		IF Item = 1 THEN BEGIN {- OK button case -}
			Done:=True;
			
			WCream:=ItemSel(3);
			Fudge:=ItemSel(4);
			Cheez:=ItemSel(5);
			spicySalsa:=ItemSel(6);
			Cherry:=ItemSel(7);			
		END
		ELSE IF Item = 2 THEN BEGIN {- Cancel button case -}
			Stop:=True;
			Done:=True;
		END
		ELSE IF Item = 3 THEN BEGIN {- Whipped Cream -}
				SetItem(3,True);
				SetItem(4,False);
				SetItem(5,False);
				SetItem(6,False);
		END
		ELSE IF Item = 4 THEN BEGIN {- Fudge Sauce -}
				SetItem(3,False);
				SetItem(4,True);
				SetItem(5,False);
				SetItem(6,False);
		END
		ELSE IF Item = 5 THEN BEGIN {- Cheez Wiz -}
				SetItem(3,False);
				SetItem(4,False);
				SetItem(5,True);
				SetItem(6,False);
		END
		ELSE IF Item = 6 THEN BEGIN {- Salsa -}
				SetItem(3,False);
				SetItem(4,False);
				SetItem(5,False);
				SetItem(6,True);
		END
		ELSE IF Item = 7 THEN BEGIN {- the cherry -}
			IF ItemSel(7) THEN
				SetItem(7,False)
			ELSE
				SetItem(7,True);
		END;
	UNTIL Done;
	
	ClrDialog;
	
END;

{ - Begin Main -}

BEGIN
	DialogDriver(Abort);
	
	IF NOT Abort THEN BEGIN
	
		IF WCream THEN BEGIN
			SysBeep;
		END
		ELSE IF Fudge THEN BEGIN
			SysBeep;
			SysBeep;
		END
		ELSE IF Cheez THEN BEGIN
			SysBeep;
			SysBeep;
			SysBeep;
		END
		ELSE IF spicySalsa THEN BEGIN
			SysBeep;
			SysBeep;
			SysBeep;
			SysBeep;
		END;
	
		IF Cherry THEN
			Message('Cherry on top!');
	END;
END;
Run(Dessert);

What it does
Creates a custom dialog in MiniPascal.

Description
The macro illustrates the components necessary to implement a custom dialog in MiniPascal. When creating custom dialogs, you are responsible for defining, centering, and operating, or "driving", the dialog.

The subroutine AlignScreen() calculates the screen center, and is used in the subroutine DefineDialog() to center the dialog. The subroutine DialogDriver() runs the loop which controls the operation of the dialog, including the radio buttons and check boxes.

[Home][Basic]