Sample Macro Directory

ARROW Specifically designed as an introduction to DCAL for the beginner. The macro enters a simple arrow into a drawing made up of lines. The macro is extensively commented, explaining virtually every line of code in detail.

ATR Demonstrates how to create symbols in a drawing, and how to add attributes to entities, symbol descriptions, and to a drawing at the system level.

CONCRETE 3D parametric macro using entities of type slab as a basic building block. The macro also contains some good examples of dragging cases.

CROP Demonstrates how the function CLIP may be used as an editing tool, as wel* as how to perform a basic editing operation on the database.

DAFILE Demonstrates all basic techniques necessary for operating upon a direct access, binary datafile. It uses FORMLIB for capturing and editing input data.

DOORLABL Complete source code to theDataCAD

DOORLABL macro.

DRAG Demonstrates nearly all dragging routines available in DCAL.

ENTER3D Demonstrates the techniques used for entering 3D entities from parallel projections (such as elevations).

FORMLIB A reusable toolkit for entering and editing collections of data via a forms type screen input system. This library is used by the sample macros FORM, FORMATR, and DAFILE.

FORMATR Allows the editing of sytem, symbol, and entity attributes via a forms-like interface.

FORM Outlines the steps required for using FORMLIB to create custom input screens.

GETARC Demonstrates the use of the function getarc which is used in many DC-Modeler menus.

HATCH Demonstrates how to use the hatch_mode function.

LYRUTIL Allows saving and reloading collections of layers. Primarily designed for packing large drawing files or recovering corrupted data files.

MENU3D Demonstrates all menu calls to the 3D Viewer and DC-Modeler. PLOT Demonstrates the use of the plot_mode procedure.

POLYLINE Demonstrates polyvert procedures and functions as well as polyline input.

REVSURF Demonstrates techniques for creating surfaces of revolution.

READTEXT Demonstrates techniques for reading text files and adding their contents to a drawing.

SPIRAL The parametric SPIRAL stair macro included with DataCAD.

STAIR The parametric STAIR macro included with DataCAD.

STUD The parametric STUD macro for creating drawings of stud wall construction.

SYMEXP Takes the instance of a symbol in a drawing and explodes it into individual entities.

SYMTMPLT Examines all of the symbols in a drawing and creates a template file from the information. Particularly useful for DXF-IN operations.

VIEWMAST Complete source code to the

VIEWMAST macro included with the DC- Modeler. Demonstrates nearly all of the functions and procedures related to viewing and saved views.

WNDWLABL The WNDWLABL macro included with DataCAD.

WRITE Demonstrates how to scan a database and write out the entire contents of each entity to a text file. May be used as a skeleton for macros which interrogate the database and write its contents to a file in one or another form for post processing.

WRTUTLA set of utilities for creating messages. WRTUTL is used by many of the sample macros in this collection.

Each macro is in a separate sub-directory. Many macros include a .lnk or a .bat file. The .lnk file contains the linker statement used by the dcl.exe linker. When there are more than one object file, the .lnk file simplifies the linking process. Take for example the CONCRETE macro, to link it, use the command:

dcl <concrete.lnk

The .bat files are like MAKE files in that they recompile all modules of the macro and then relink the macro. To recompile and relink the entire CONCRETE macro, type:

CONCRETE

The batch and linker files assume that each sample macro is in a separate sub-directory, and that the system includes files are in a sub- directory at the same directory level. As well, macros which use the WRTUTL library also assume that the WRTUTL subdirectory is at the same directory level.

MTEC ----|-- DCX ----|-- INC System includes

files

| |-- WRTUTL Message utilities

| |-- ARROW Arrow macro

| |-- CONCRETE Concrete macro

| .

| . etc.

| .

|-- DWG

|-- SUP

|-- SYM

|-- TPL

In each macro and in each .lnk file, the pathnames for system includes files, and for object files are designed with the above directory structure in mind. All pathnames are relative, such that the name of the DCX subdirectory is unimportant, only the location of the INC and WRTUTL directories relative to the macro source code.

Hatch

This program is a simple example of the routine hatch_mode. It uses a hardwired brick hatch pattern.

PROGRAM hatch;

#include '../wrtutl/wrtutl.inc'

#include '../inc/_hatch.inc'

CONST

ssNum = 15;

PROCEDURE getOrigin (org : IN OUT point);

VAR

done: boolean;

result : integer;

key : integer;

pt : point;

BEGIN

done := false;

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtlvl (Hatch);

wrtmsg (Enter hatch origin.);

result := getpoint (pt, key);

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

ELSIF result = res_normal THEN

org := pt;

done := true;

END;

UNTIL done;

END getOrigin;

PROCEDURE getHtype (htype : IN OUT integer);

VAR

done : boolean;

key : integer;

BEGIN

done := false;

REPEAT

lblsinit;

lblset ( 1, 'Normal);

lblset ( 2, 'Outer);

lblset ( 3, 'Ignore);

lblset (20, 'Exit);

lblson;

wrtlvl (Hatch);

wrtmsg (Select hatch type.);

getesc (key);

IF key = f1 THEN

htype := htype_normal;

done := true;

ELSIF key = f2 THEN

htype := htype_outer;

done := true;

ELSIF key = f3 THEN

htype := htype_ignore;

done := true;

ELSIF key = s0 THEN

done := true;

END;

UNTIL done;

END getHtype;

PROCEDURE hatch_main;

VAR

sl : scanLineType;

done : boolean;

result : integer;

brk : integer;

key : integer;

mode : mode_type;

mode1 : mode_type;

ent : entity;

addr : entaddr;

minPt : point;

maxPt : point;

min1 : point;

max1 : point;

frst : boolean;

ang : real;

scale : real;

org : point;

htype : integer;

BEGIN

done := false;

setpoint (org, 0.0);

ang := 0.0;

htype := htype_normal;

scale := 1.0;

REPEAT

REPEAT

lblsinit;

lblset (10, 'HtchType);

lblset (12, 'Scale);

lblset (13, 'Angle);

lblset (14, 'Origin);

lblset (20, 'Exit);

wrtlvl (Hatch);

result := getmode (hatch', mode, key);

IF result = res_escape THEN

IF key = f0 THEN

getHtype (htype);

ELSIF key = s2 THEN

wrtmsg (Enter hatch scale: );

getrll (scale);

ELSIF key = s3 THEN

wrtmsg (Enter hatch angle: );

getang (ang);

ELSIF key = s4 THEN

getOrigin (org);

ELSIF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

{ find the extents of the entities and

place them into a selection set }

ssClear (ssNum);

frst := true;

addr := ent_first (mode);

WHILE ent_get (ent, addr) DO

addr := ent_next (ent, mode);

ssAdd (ssNum, ent);

ent_extent (ent, min1, max1);

IF frst THEN

minPt := min1;

maxPt := max1;

frst := false;

ELSE

minPt.x := min (min1.x, minPt.x);

minPt.y := min (min1.y, minPt.y);

minPt.z := min (min1.z, minPt.z);

maxPt.x := max (max1.x, maxPt.x);

maxPt.y := max (max1.y, maxPt.y);

maxPt.z := max (max1.z, maxPt.z);

END;

END;

brk := 0;

mode_init (mode);

mode_ss (mode, ssNum);

{ get the entities out of the selection set}

{ draw the horizontal lines 2 2/3 inches apart }

sl.ang := 0.0;

setpoint (sl.origin, 0.0);

sl.delta.x := 0.0;

sl.delta.y := 2.6667 * 32.0;

sl.numdash := 0;

hatch_mode (mode, sl, zbase, zhite, org,

ang, scale, htype,

getlyrcurr, minPt, maxPt, true, brk, true);

{ draw the vertical (dashed) lines every 8 inches }

sl.ang := halfpi; { oriented vertically }

setpoint (sl.origin, 0.0);

sl.delta.x := 2.6667 * 32.0;

sl.delta.y := 4.0 * 32.0;

sl.numdash := 2;

sl.dash [1] := 2.6667 * 32.0;

sl.dash [2] := 2.6667 * 32.0;

sl.dashDraw [1] := true;

sl.dashDraw [2] := false;

hatch_mode (mode, sl, zbase, zhite, org,

ang, scale, htype,

getlyrcurr, minPt, maxPt, true, brk, true);

ssClear (ssNum);

END;

UNTIL done;

END hatch_main;

BEGIN

hatch_main;

END hatch.

Plot1

This program gives examples of the plotter routines available through a DCAL macro.

PROGRAM plot1;

#include '../wrtutl/wrtutl.inc'

#include '../inc/_plot.inc'

VAR

done : boolean;

key : integer;

cent : point;

wndwMin : point;

wndwMax : point;

vwptMin : point;

vwptMax : point;

tofile : boolean;

fname : str80;

paperx : real;

papery : real;

init : boolean;

ang : real;

ManyPens : boolean;

PROCEDURE getPaper (size : integer; custx, custy : real;

x, y : IN OUT real);

BEGIN

IF size = 1 THEN

x := 10.5;

y := 8.0;

ELSIF size = 2 THEN

x := 16.0;

y := 10.0;

ELSIF size = 3 THEN

x := 21.0;

y := 16.0;

ELSIF size = 4 THEN

x := 33.0;

y := 21.0;

ELSIF size = 5 THEN

x := 43.0;

y := 33.0;

ELSE

x := custx;

y := custy;

END;

x := x * 32.0; { convert from inches to world coords }

y := y * 32.0; { convert from inches to world coords }

END getPaper;

PROCEDURE wrtPaperErr;

BEGIN

errStart;

errDis (paperx);

errStr ( );

errDis (papery);

errShow;

END wrtPaperErr;

PROCEDURE doplot;

VAR

plot : plot_type;

mode : mode_type;

key : integer;

BEGIN

IF plot_open (pltpenwidth, pltpenspeed, paperx, papery,

tofile, 'test.plt', 1, plot) = fl_ok THEN

wrterr (ok);

wrtmsg (Plotting...);

mode_init (mode);

mode_lyr (mode, lyr_on);

plot_mode (plot, mode, ManyPens, pltpensort, pltcolor,

vwptMin, vwptMax, wndwMin, wndwMax, cent, ang);

plot_close (plot);

END;

END doplot;

PROCEDURE getVwpt (min, max : IN OUT point);

VAR

minPt,

maxPt : point;

screenRatio : real;

paperRatio : real;

minBox,

maxBox : point;

done : boolean;

key : integer;

result : integer;

pt1 : point;

pt2 : point;

pt3 : point;

BEGIN

IF (absr (wndwMax.x - wndwMin.x) < 0.01) OR

(absr (wndwMax.y - wndwMin.y) < 0.01) THEN

wrterr (Invalid window, select window first.);

ELSE

{ draw the sheet of paper on the screen }

vwptClear;

currWndw (minPt, maxPt);

screenRatio := (maxPt.x - minPt.x) /

(maxPt.y - minPt.y);

paperRatio := paperx / papery;

IF paperRatio < screenRatio THEN

ELSE

END;

done := false;

REPEAT

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtmsg (Enter first corner of viewport.);

result := getpoint (pt1, key);

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtmsg (Enter second corner of viewport.);

ratioBox := true;

ratioRatio := (wndwMax.x -

wndwMin.x)/(wndwMax.y - wndwMin.y);

rubbx := true;

result := getpoint (pt2, key);

ratioBox := false;

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtmsg (Position viewport.);

minBox.x := pt1.x - pt2.x;

minBox.y := pt1.y - pt2.y;

setPoint (maxBox, 0.0);

setpoint (pt3, 0.0);

dragBoxMove (pt3, minBox, maxBox,

linecolor);

result := getpoint (pt3, key);

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

END;

END;

END;

UNTIL done;

wrtmsg (Enter vwptMin.x: );

getdis (min.x);

wrtmsg (Enter vwptMin.y: );

getdis (min.y);

wrtmsg (Enter vwptMax.x: );

getdis (max.x);

wrtmsg (Enter vwptMax.y: );

getdis (max.y);

END;

END getVwpt;

PROCEDURE getWndw (min, max : IN OUT point);

VAR

done : boolean;

key: integer;

result : integer;

pt1: point;

pt2: point;

BEGIN

done := false;

REPEAT

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtmsg (Enter first corner of window.);

result := getpoint (pt1, key);

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtmsg (Enter second corner of window.);

rubbx := true;

result := getpoint (pt2, key);

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

order (pt1.x, pt2.x, min.x, max.x);

order (pt1.y, pt2.y, min.y, max.y);

{ if we entered both points, get out }

done := true;

ELSE

{ if we pressed exit, go back to the

previous loop }

done := false;

END;

END;

UNTIL done;

END getWndw;

PROCEDURE extra;

VAR

done : boolean;

key : integer;

BEGIN

done := false;

REPEAT

lblsinit;

lblset ( 1, 'Plot);

lblsett ( 2, 'To File', tofile);

lblset ( 3, 'Vwpt);

lblset ( 4, 'Wndw);

lblset ( 5, 'Paper);

lblset (20, 'Exit);

lblson;

wrtmsg (Select plotter function.);

wrtPaperErr;

getesc (key);

IF key = f1 THEN

doPlot;

ELSIF key = f2 THEN

tofile := NOT tofile;

ELSIF key = f3 THEN

getVwpt (vwptMin, vwptMax);

ELSIF key = f4 THEN

getWndw (wndwMin, wndwMax);

ELSIF key = f5 THEN

ELSIF key = s0 THEN

done := true;

END;

UNTIL done;

END extra;

PROCEDURE layout;

VAR

done : boolean;

pt : point;

key: integer;

result : integer;

min: point;

max: point;

str: str80;

fac: real;

BEGIN

done := false;

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

wrtlvl (Layout);

wrtmsg (Enter center of plot.);

getPaper (pltPSize, pltPCustx, pltPCusty,

paperx, papery);

scale_get (pltScaleNum, fac, str);

setpoint (pt, 0.0);

min.x := -paperx / 2.0 / fac;

min.y := -papery / 2.0 / fac;

max.x := -min.x;

max.y := -min.y;

dragBoxMove (pt, min, max, linecolor);

result := getpoint (pt, key);

IF result = res_escape THEN

IF key = s0 THEN

done := true;

END;

END;

UNTIL done OR (result = res_normal);

IF NOT done THEN

pltcentx := pt.x;

pltcenty := pt.y;

END;

END layout;

PROCEDURE doplotData;

VAR

vwptMin : point;

vwptMax : point;

wndwMin : point;

wndwMax : point;

str : str80;

fac : real;

plot : plot_type;

mode : mode_type;

cent : point;

ang : real;

BEGIN

getPaper (pltPSize, pltPCustx, pltPCusty,

paperx, papery);

scale_get (pltScaleNum, fac, str);

vwptmin.x := 0.0;

vwptmin.y := 0.0;

vwptmax.x := paperx;

vwptmax.y := papery;

wndwMin.x := pltCentx - paperx / 2.0 / fac;

wndwMin.y := pltCenty - papery / 2.0 / fac;

wndwMax.x := pltCentx + paperx / 2.0 / fac;

wndwMax.y := pltCenty + papery / 2.0 / fac;

setpoint (cent, 0.0);

ang := 0.0;

IF plot_open (pltpenwidth, pltpenspeed,

paperx, papery, false, 'test.plt', 1, plot)

= fl_ok THEN

wrterr (ok);

wrtmsg (Plotting...);

mode_init (mode);

mode_lyr (mode, lyr_on);

plot_mode (plot, mode, ManyPens, pltpensort, pltcolor,

vwptMin, vwptMax, wndwMin, wndwMax, cent, ang);

plot_close (plot);

END;

END doplotData;

PROCEDURE scale;

VAR

i : integer;

str : str80;

done : boolean;

fac : real;

BEGIN

done := false;

REPEAT

lblsinit;

FOR i := 1 TO 18 DO

scale_get (i, fac, str);

lblset (i, str);

cvrllst (fac, str);

lblmsg (i, str);

END;

lblset (20, 'NoChange);

lblson;

wrtlvl (Scale);

wrtmsg (Select plotter scale.);

getesc (key);

i := fnKeyConv (key);

IF ((1 <= i) AND (i <= 18)) THEN

pltScaleNum := i;

done := true;

ELSIF key = s0 THEN

done := true;

END;

UNTIL done;

END scale;

PROCEDURE doPaper;

VAR

done: boolean;

key : integer;

result : integer;

r : real;

BEGIN

done := false;

REPEAT

lblsinit;

lblsett ( 1, '8.5x11A', pltPsize = 1);

lblsett ( 2, '11x17 B', pltPsize = 2);

lblsett ( 3, '18x24 C', pltPsize = 3);

lblsett ( 4, '24x36 D', pltPsize = 4);

lblsett ( 5, '36x48 E', pltPsize = 5);

lblsett ( 7, ' Custom', pltPsize = 6);

lblset (20, 'NoChange);

lblson;

wrtlvl (PaperSiz);

wrtmsg (Select paper size.);

getPaper (pltPSize, pltPCustx, pltPCusty,

paperx, papery);

wrtPaperErr;

getesc (key);

IF key = f1 THEN

pltPsize := 1;

ELSIF key = f2 THEN

pltPsize := 2;

ELSIF key = f3 THEN

pltPsize := 3;

ELSIF key = f4 THEN

pltPsize := 4;

ELSIF key = f5 THEN

pltPsize := 5;

ELSIF key = f7 THEN

wrtmsg (Enter plotting width ("X" axis):);

r := pltPcustx * 32.0;

getdis (r);

pltPcustx := r / 32.0;

wrtmsg (Enter plotting height ("Y" axis):);

r := pltPcusty * 32.0;

getdis (r);

pltPcusty := r / 32.0;

pltPsize := 6; { custom }

ELSIF key = s0 THEN

done := true;

END;

UNTIL done;

END doPaper;

VAR

str : str80;

str1 : str80;

i : integer;

fac : real;

BEGIN

done := false;

IF NOT init THEN

getPaper (pltPSize, pltPCustx, pltPCusty,

paperx, papery);

tofile := false;

fname := '';

setpoint (vwptMin, 0.0);

vwptMax.x := paperx;

vwptMax.y := papery;

setpoint (wndwMin, 0.0);

setpoint (wndwMax, 0.0);

setpoint (cent, 0.0);

ang := 0.0;

ManyPens := false;

init := true;

END;

REPEAT

lblsinit;

lblset ( 1, 'Plot);

lblmsg ( 1, 'Plot all layers that are

turned on.);

lblset ( 2, 'Backgrnd);

lblmsg ( 2, 'Background plotting.);

lblset ( 3, 'To File);

lblset ( 4, 'Scale);

str := 'Current scale = ';

scale_get (pltScaleNum, fac, str1);

strcat (str, str1);

lblmsg ( 4, str);

lblset ( 5, 'PaperSiz);

lblset ( 6, 'PenSpeed);

lblmsg ( 6, 'Set plotter pen speed.);

lblset ( 7, 'PenWidth);

lblmsg ( 7, 'Set plotter pen width.);

lblset ( 8, 'Partial);

lblset ( 9, 'Layout);

lblset (10, 'Lyout Sz);

lblset (11, 'LyoutDiv);

lblsett (12, 'Rotate', pltRot);

lblsett (13, 'ClrPlot', pltColor);

IF ManyPens AND pltColor THEN

lblset (14, 'Set Pens);

lblsett (15, 'PenSort', pltpensort);

END;

lblsett (16, 'ManyPens', ManyPens);

lblset (19, 'extra);

lblset (20, 'Exit);

lblson;

wrtlvl (Plotter);

wrtmsg (Select plotter function.);

getesc (key);

IF key = f1 THEN

doplotData;

ELSIF key = f2 THEN

ELSIF key = f3 THEN

ELSIF key = f4 THEN

scale;

ELSIF key = f5 THEN

doPaper;

ELSIF key = f6 THEN

wrtlvli (146 {'PenSpeed'});

wrtmsgi (172);

i := pltpenspeed;

getint (i);

pltpenspeed := absi (i);

ELSIF key = f7 THEN

ELSIF key = f8 THEN

ELSIF key = f9 THEN

layout;

ELSIF key = f0 THEN

ELSIF key = s1 THEN

ELSIF key = s2 THEN

ELSIF key = s3 THEN

pltColor := NOT pltColor;

ELSIF key = s4 THEN

IF pltColor AND ManyPens THEN

END;

ELSIF key = s5 THEN

pltpensort := NOT pltpensort;

ELSIF key = s6 THEN

ManyPens := NOT ManyPens;

ELSIF key = s9 THEN

extra;

ELSIF key = s0 THEN

done := true;

END;

UNTIL done;

END plot1.

Stair

PROGRAM stair;

VAR

str1 : string (80);

str : string (20);

ch : char;

init,

getout,

done1,

done : boolean;

result,

clr,

oldcolor,

stairtype,

key : integer;

stairnum,

numrisers : integer;

angle1, { angle up stairs }

angle2: real;{ angle across stairs }

cent1,

cent,

pt1,

pt2,

pt3,

pt4 : point;

zstart,

riserheight,

depth,

width : real;

{

*************************************

* *

* <- depth ->*

* *

* pt4-------pt3 *

* | ^ |*

* | | |*

* | | |*

* | w |*

* | i |*

* | d |*

* | t |*

* | h |*

* | | |*

* | | |*

* | v |*

* pt1-------pt2 *

* *

*************************************

}

PROCEDURE addriser (pt1, pt2, pt3, pt4 : point;

num : integer);

CONST

zero = 0.0;

VAR

ent : entity;

BEGIN

ent_init (ent, entblk);

ent.blkpnt [ 1].x := pt1.x;

ent.blkpnt [ 1].y := pt1.y;

ent.blkpnt [ 1].z := zstart + (float (num) *

riserheight);

ent.blkpnt [ 2].x := pt2.x;

ent.blkpnt [ 2].y := pt2.y;

ent.blkpnt [ 2].z := zstart + (float (num) *

riserheight);

ent.blkpnt [ 3].x := pt4.x;

ent.blkpnt [ 3].y := pt4.y;

ent.blkpnt [ 3].z := zstart + (float (num) *

riserheight);

ent.blkpnt [ 4].x := pt1.x;

ent.blkpnt [ 4].y := pt1.y;

ent.blkpnt [ 4].z := zstart + (float (num) *

riserheight) + riserheight;

ent_add (ent);

ent_draw (ent, drmode_white);

END addriser;

PROCEDURE doesc (key : integer; getout : OUT

boolean);

BEGIN

IF key = f1 THEN

wrterr (Drawing stairs by left side.);

stairtype := 1;

ELSIF key = f2 THEN

wrterr (Drawing stairs by right side.);

stairtype := 2;

ELSIF key = f3 THEN

wrterr (Drawing stairs by center line.);

stairtype := 3;

ELSIF key = f5 THEN

wrtmsg (Enter the number of risers: );

getint (numrisers);

ELSIF key = f6 THEN

wrtmsg (Enter the width of the stairs: );

getdis (width);

ELSIF key = f7 THEN

wrtmsg (Enter the height of the risers: );

getdis (riserheight);

ELSIF key = f8 THEN

wrtmsg (Enter the depth of tread: );

getdis (depth);

ELSIF key = f9 THEN

wrtmsg (Select color of stairs.);

getclr (clr);

ELSIF key = f0 THEN

wrtmsg (Enter the starting height of the

stairs: );

getdis (zstart);

ELSIF key = s0 THEN

getout := true;

END;

END doesc;

PROCEDURE setkeys;

BEGIN

lblsinit;

lblsett ( 1, ' Left', (stairtype = 1));

lblsett ( 2, ' Right', (stairtype = 2));

lblsett ( 3, ' Center', (stairtype = 3));

lblset ( 5, 'NumRisrs);

lblset ( 6, 'Width);

lblset ( 7, 'Height);

lblset ( 8, 'Depth);

lblset ( 9, 'Color);

lblset (10, 'Start Ht);

lblset (20, 'Exit);

lblson;

END setkeys;

PROCEDURE get_point1;

BEGIN

REPEAT

setkeys;

IF stairtype = 3 THEN

str := 'center';

ELSIF stairtype = 1 THEN

str := 'left side';

ELSE

str := 'right side';

END;

str1 := 'Enter ';

strcat (str1, str);

strcat (str1, ' of stairs at bottom.);

wrtmsg (str1);

result := getpoint (cent, key);

IF result = res_escape THEN

doesc (key, getout);

END;

UNTIL (result = res_normal) OR getout;

END get_point1;

PROCEDURE get_point2;

BEGIN

REPEAT

lblsinit;

lblset (20, 'Exit);

lblson;

str1 := 'Enter another point on the ';

strcat (str1, str);

strcat (str1, ' of the stairs.);

wrtmsg (str1);

rubln := true;

result := getpoint (cent1, key);

IF result = res_escape THEN

IF key = s0 THEN

getout := true;

END;

END;

UNTIL (result = res_normal) OR getout;

END get_point2;

PROCEDURE setitup;

BEGIN

light (true);

lblsinit;

lblset ( 8, '********);

lblset (10, 'WORKING);

lblset (12, '********);

lblson;

wrtmsg (Constructing stairs, please wait.);

angle1 := angle (cent, cent1);

angle2 := angle1 - radians (90.0);

{ calculate the first point, from now on, all

of the cases are the same }

IF stairtype = 3 THEN

{ we have the center, move to the left half the width }

polar (cent, angle2, -width / 2.0, pt1);

ELSIF stairtype = 1 THEN

{ we already have the left, don't need to calculate anything }

pt1 := cent;

ELSE

{ we have the right side, move to the left by an entire stair width }

polar (cent, angle2, -width, pt1);

END;

oldcolor := linecolor;

linecolor := clr;

stairnum := 1;

END setitup;

PROCEDURE doit;

BEGIN

stopgroup;

WHILE stairnum <= numrisers DO

polar (pt1, angle1, depth, pt2);

polar (pt1, angle2, width, pt4);

polar (pt2, angle2, width, pt3);

addriser (pt1, pt2, pt3, pt4, stairnum -1);

pt1 := pt2;

stairnum := stairnum + 1;

END;

stopgroup;

light (false);

END doit;

PROCEDURE initialize;

BEGIN

stairtype := 1;

clr := linecolor;

numrisers := 12;

width := 1536.0;

riserheight := 192.0;

depth := 256.0;

zstart := 0.0;

init := true;

END initialize;

BEGIN

{ set up defaults }

IF NOT init THEN

initialize;

END;

getout := false;

wrtlvl (Stair);

REPEAT

get_point1;

IF NOT getout THEN

get_point2;

IF NOT getout THEN

setitup;

doit;

linecolor := oldcolor;

END;

END;

UNTIL getout;

END stair.