Updated readme

This commit is contained in:
neauoire 2020-05-07 18:47:11 +09:00
commit e592018aeb
79 changed files with 68122 additions and 0 deletions

7
README.md Normal file
View File

@ -0,0 +1,7 @@
# The Macintosh Cookbook
This is a collection of tools and example files to make classic Macintosh applications using the [THINK Pascal](https://wiki.xxiivv.com/site/pascal.html) environment.
More details shortly.

63071
docs/macintosh inside.html Normal file

File diff suppressed because it is too large Load Diff

222
docs/pascal quickdraw.html Normal file
View File

@ -0,0 +1,222 @@
<h1>Summary of QuickDraw Drawing</h1>
<pre>
srcCopy = 0; {where source pixel is black, force destination }
{ pixel black; where source pixel is white, force }
{ destination pixel white}
srcOr = 1; {where source pixel is black, force destination }
{ pixel black; where source pixel is white, leave }
{ destination pixel unaltered}
srcXor = 2; {where source pixel is black, invert destination }
{ pixel; where source pixel is white, leave }
{ destination pixel unaltered}
srcBic = 3; {where source pixel is black, force destination }
{ pixel white; where source pixel is white, leave }
{ destination pixel unaltered}
notSrcCopy = 4; {where source pixel is black, force destination }
{ pixel white; where source pixel is white, force }
{ destination pixel black}
notSrcOr = 5; {where source pixel is black, leave destination }
{ pixel unaltered; where source pixel is white, }
{ force destination pixel black}
notSrcXor = 6; {where source pixel is black, leave destination }
{ pixel unaltered; where source pixel is white, }
{ invert destination pixel}
notSrcBic = 7; {where source pixel is black, leave destination }
{ pixel unaltered; where source pixel is white, }
{ force destination pixel white}
{pattern modes}
patCopy = 8; {where pattern pixel is black, apply foreground }
{ color to destination pixel; where pattern pixel }
{ is white, apply background color to destination }
{ pixel}
patOr = 9; {where pattern pixel is black, invert destination }
{ pixel; where pattern pixel is white, leave }
{ destination pixel unaltered}
patXor = 10; {where pattern pixel is black, invert destination }
{ pixel; where pattern pixel is white, leave }
{ destination pixel unaltered}
patBic = 11; {where pattern pixel is black, apply background }
{ color to destination pixel; where pattern pixel }
{ is white, leave destination pixel unaltered}
notPatCopy = 12; {where pattern pixel is black, apply background }
{ color to destination pixel; where pattern pixel }
{ is white, apply foreground color to destination }
{ pixel}
notPatOr = 13; {where pattern pixel is black, leave destination }
{ pixel unaltered; where pattern pixel is white, }
{ apply foreground color to destination pixel}
notPatXor = 14; {where pattern pixel is black, leave destination }
{ pixel unaltered; where pattern pixel is white, }
{ invert destination pixel}
notPatBic = 15; {where pattern pixel is black, leave destination }
{ pixel unaltered; where pattern pixel is white, }
{ apply background color to destination pixel}
ditherCopy = 64; {add to source mode for dithering}
</pre>
<h3>Routines</h3>
<h4>Managing the Graphics Pen</h4>
<pre>PROCEDURE HidePen;
PROCEDURE ShowPen;
PROCEDURE GetPen (VAR pt: Point);
PROCEDURE GetPenState (VAR pnState: PenState);
PROCEDURE SetPenState (pnState: PenState);
PROCEDURE PenSize (width,height: Integer);
PROCEDURE PenMode (mode: Integer);
PROCEDURE PenPat (pat: Pattern);
PROCEDURE PenNormal;
</pre>
<h4>Changing the Background Bit Pattern</h4>
<pre>PROCEDURE BackPat (pat: Pattern);
</pre>
<h4>Drawing Lines</h4>
<pre>PROCEDURE MoveTo (h,v: Integer);
PROCEDURE Move (dh,dv: Integer);
PROCEDURE LineTo (h,v: Integer);
PROCEDURE Line (dh,dv: Integer);
</pre>
<h4>Creating and Managing Rectangles</h4>
<pre>PROCEDURE SetRect (VAR r: Rect; left,top,right,bottom: Integer);
PROCEDURE OffsetRect (VAR r: Rect; dh,dv: Integer);
PROCEDURE InsetRect (VAR r: Rect; dh,dv: Integer);
PROCEDURE UnionRect (src1,src2: Rect; VAR dstRect: Rect);
PROCEDURE Pt2Rect (pt1,pt2: Point; VAR dstRect: Rect);
PROCEDURE PtToAngle (r: Rect; pt: Point; VAR angle: Integer);
FUNCTION SectRect (src1,src2: Rect; VAR dstRect: Rect): Boolean;
FUNCTION PtInRect (pt: Point; r: Rect): Boolean;
FUNCTION EqualRect (rect1,rect2: Rect): Boolean;
FUNCTION EmptyRect (r: Rect): Boolean;
</pre>
<h4>Drawing Rectangles</h4>
<pre>PROCEDURE FrameRect (r: Rect);
PROCEDURE PaintRect (r: Rect);
PROCEDURE FillRect (r: Rect; pat: Pattern);
PROCEDURE EraseRect (r: Rect);
PROCEDURE InvertRect (r: Rect);
</pre>
<h4>Drawing Rounded Rectangles</h4>
<pre>PROCEDURE FrameRoundRect (r: Rect; ovalWidth,ovalHeight: Integer);
PROCEDURE PaintRoundRect (r: Rect; ovalWidth,ovalHeight: Integer);
PROCEDURE FillRoundRect (r: Rect; ovalWidth,ovalHeight: Integer; pat: Pattern);
PROCEDURE EraseRoundRect (r: Rect; ovalWidth,ovalHeight: Integer);
PROCEDURE InvertRoundRect (r: Rect; ovalWidth,ovalHeight: Integer);
</pre>
<h4>Drawing Ovals</h4>
<pre>PROCEDURE FrameOval (r: Rect);
PROCEDURE PaintOval (r: Rect);
PROCEDURE FillOval (r: Rect; pat: Pattern);
PROCEDURE EraseOval (r: Rect);
PROCEDURE InvertOval (r: Rect);
</pre>
<h4>Drawing Arcs and Wedges</h4>
<pre>PROCEDURE FrameArc (r: Rect; startAngle,arcAngle: Integer);
PROCEDURE PaintArc (r: Rect; startAngle,arcAngle: Integer);
PROCEDURE FillArc (r: Rect; startAngle,arcAngle: Integer; pat: Pattern);
PROCEDURE EraseArc (r: Rect; startAngle,arcAngle: Integer);
PROCEDURE InvertArc (r: Rect; startAngle,arcAngle: Integer);
</pre>
<h4>Creating and Managing Polygons</h4>
<pre>FUNCTION OpenPoly : PolyHandle;
PROCEDURE ClosePoly;
PROCEDURE OffsetPoly (poly: PolyHandle; dh,dv: Integer);
PROCEDURE KillPoly (poly: PolyHandle);
</pre>
<h4>Drawing Polygons</h4>
<pre>PROCEDURE FramePoly (poly: PolyHandle);
PROCEDURE PaintPoly (poly: PolyHandle);
PROCEDURE FillPoly (poly: PolyHandle; pat: Pattern);
PROCEDURE ErasePoly (poly: PolyHandle);
PROCEDURE InvertPoly (poly: PolyHandle);
</pre>
<h4>Creating and Managing Regions</h4>
<pre>FUNCTION NewRgn : RgnHandle;
PROCEDURE OpenRgn;
PROCEDURE CloseRgn (dstRgn: rgnHandle);
PROCEDURE DisposeRgn (rgn: RgnHandle);
PROCEDURE CopyRgn (srcRgn,dstRgn: RgnHandle);
PROCEDURE SetEmptyRgn (rgn: RgnHandle);
PROCEDURE SetRectRgn (rgn: RgnHandle; left,top,right,bottom: Integer);
PROCEDURE RectRgn (rgn: RgnHandle; r: Rect);
PROCEDURE OffsetRgn (rgn: RgnHandle; dh,dv: Integer);
PROCEDURE InsetRgn (rgn: RgnHandle; dh,dv: Integer);
PROCEDURE SectRgn (srcRgnA,srcRgnB,dstRgn: RgnHandle);
PROCEDURE UnionRgn (srcRgnA,srcRgnB,dstRgn: RgnHandle);
PROCEDURE DiffRgn (srcRgnA,srcRgnB,dstRgn: RgnHandle);
PROCEDURE XorRgn (srcRgnA,srcRgnB,dstRgn: RgnHandle);
FUNCTION PtInRgn (pt: Point; rgn: RgnHandle): Boolean;
FUNCTION RectInRgn (r: Rect; rgn: RgnHandle): Boolean;
FUNCTION EqualRgn (rgnA,rgnB: RgnHandle): Boolean;
FUNCTION EmptyRgn (rgn: RgnHandle): Boolean;
</pre>
<h4>Drawing Regions</h4>
<pre>PROCEDURE FrameRgn (rgn: RgnHandle);
PROCEDURE PaintRgn (rgn: RgnHandle);
PROCEDURE FillRgn (rgn: RgnHandle; pat: Pattern);
PROCEDURE EraseRgn (rgn: RgnHandle);
PROCEDURE InvertRgn (rgn: RgnHandle);
</pre>
<h4>Scaling and Mapping Points, Rectangles, Polygons, and Regions</h4>
<pre>PROCEDURE ScalePt (VAR pt: Point; srcRect,dstRect: Rect);
PROCEDURE MapPt (VAR pt: Point; srcRect,dstRect: Rect);
PROCEDURE MapRect (VAR r: Rect; srcRect,dstRect: Rect);
PROCEDURE MapRgn (rgn: RgnHandle; srcRect,dstRect: Rect);
PROCEDURE MapPoly (poly: PolyHandle; srcRect,dstRect: Rect);
</pre>
<h4>Calculating Black-and-White Fills</h4>
<pre>PROCEDURE SeedFill (srcPtr,dstPtr: Ptr; srcRow,dstRow,height,words,seedH,seedV: Integer);
PROCEDURE CalcMask (srcPtr,dstPtr: Ptr; srcRow,dstRow,height,words: Integer);
</pre>
<h4>Copying Images</h4>
<pre>PROCEDURE CopyBits (srcBits,dstBits: BitMap; srcRect,dstRect: Rect; mode: Integer; maskRgn: RgnHandle);
PROCEDURE CopyMask (srcBits,maskBits,dstBits: BitMap; srcRect,maskRect,dstRect: Rect);
PROCEDURE CopyDeepMask (srcBits: BitMap; maskBits: BitMap; dstBits: BitMap; srcRect: Rect; maskRect: Rect; dstRect: Rect; mode: Integer; maskRgn: RgnHandle);
</pre>
<h4>Drawing With the Eight-Color System</h4>
<pre>PROCEDURE ForeColor (color: LongInt);
PROCEDURE BackColor (color: LongInt);
PROCEDURE ColorBit (whichBit: Integer);
</pre>
<h4>Determining Whether QuickDraw Has Finished Drawing</h4>
<pre>FUNCTION QDDone (port: GrafPtr): Boolean;
</pre>
<h4>Getting Pattern Resources</h4>
<pre>FUNCTION GetPattern (patID: Integer): PatHandle;
PROCEDURE GetIndPattern (VAR thePattern: Pattern; patListID: Integer; index: Integer);
</pre>
<h4>Customizing QuickDraw Operations</h4>
<pre>PROCEDURE SetStdProcs (VAR procs: QDProcs);
PROCEDURE StdText (byteCount: Integer; textBuf: Ptr; numer,denom: Point);
PROCEDURE StdLine (newPt: Point);
PROCEDURE StdRect (verb: GrafVerb; r: Rect);
PROCEDURE StdRRect (verb: GrafVerb; r: Rect; ovalwidth,ovalHeight: Integer);
PROCEDURE StdOval (verb: GrafVerb; r: Rect);
PROCEDURE StdArc (verb: GrafVerb; r: Rect; startAngle,arcAngle: Integer);
PROCEDURE StdPoly (verb: GrafVerb; poly: PolyHandle);
PROCEDURE StdRgn (verb: GrafVerb; rgn: RgnHandle);
PROCEDURE StdBits (VAR srcBits: BitMap; VAR srcRect,dstRect: Rect; mode: Integer; maskRgn: RgnHandle);
PROCEDURE StdComment (kind,dataSize: Integer; dataHandle: Handle);
FUNCTION StdTxtMeas (byteCount: Integer; textAddr: Ptr; VAR numer, denom: Point; VAR info: FontInfo): Integer;
PROCEDURE StdGetPic (dataPtr: Ptr; byteCount: Integer);
PROCEDURE StdPutPic (dataPtr: Ptr; byteCount: Integer);
</pre>

186
examples/3d.box.pas Normal file
View File

@ -0,0 +1,186 @@
program Boxes;
uses
FixMath, Graf3D;
type
Link3D = record
a: Integer;
b: Integer;
end;
var
w: WindowPtr; {A window to draw in}
r: Rect; {A window Size}
myPort: GrafPort;
myPort3D: Port3D;
pa, pb: Point3D;
hangle, vangle: Longint;
{cursor}
cursor, prev: Point;
isDown: Boolean;
{cube}
shape: array[1..9] of Point3D;
links: array[1..13] of Link3D;
{>>}
procedure SetLk3D (var lk3D: Link3D; a, b: Integer);
begin
lk3D.a := a;
lk3D.b := b;
end;
{>>}
procedure CreateCube;
begin
SetPt3D(shape[1], Long2Fix(20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[2], Long2Fix(20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[3], Long2Fix(-20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[4], Long2Fix(-20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[5], Long2Fix(20), Long2Fix(-20), Long2Fix(20));
SetPt3D(shape[6], Long2Fix(20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[7], Long2Fix(-20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[8], Long2Fix(-20), Long2Fix(-20), Long2Fix(20));
SetLk3D(links[1], 1, 2);
SetLk3D(links[2], 2, 3);
SetLk3D(links[3], 3, 4);
SetLk3D(links[4], 4, 1);
SetLk3D(links[5], 5, 6);
SetLk3D(links[6], 6, 7);
SetLk3D(links[7], 7, 8);
SetLk3D(links[8], 8, 5);
SetLk3D(links[9], 1, 5);
SetLk3D(links[10], 2, 6);
SetLk3D(links[11], 3, 7);
SetLk3D(links[12], 4, 8);
end;
{>>}
procedure PaintCube;
var
i: Integer;
begin
for i := 1 to 12 do
begin
MoveTo3D(shape[links[i].a].x, shape[links[i].a].y, shape[links[i].a].z);
LineTo3D(shape[links[i].b].x, shape[links[i].b].y, shape[links[i].b].z);
end;
end;
{>>}
procedure PaintFace;
var
tempRgn: RgnHandle;
begin
tempRgn := NewRgn;
OpenRgn;
MoveTo3D(shape[1].x, shape[1].Y, shape[1].Z);
LineTo3D(shape[2].X, shape[2].Y, shape[2].Z);
LineTo3D(shape[3].X, shape[3].Y, shape[3].Z);
LineTo3D(shape[4].X, shape[4].Y, shape[4].Z);
LineTo3D(shape[1].X, shape[1].Y, shape[1].Z);
CloseRgn(tempRgn);
FillRgn(tempRgn, gray);
end;
{>>}
procedure PaintAxis (size: Integer);
begin
PenPat(black);
MoveTo3D(0, 0, 0);
LineTo3D(Long2Fix(size), 0, 0);
WriteDraw('x');
MoveTo3D(0, 0, 0);
LineTo3D(0, Long2Fix(size), 0);
WriteDraw('y');
MoveTo3D(0, 0, 0);
LineTo3D(0, 0, Long2Fix(size));
WriteDraw('z');
end;
{>>}
procedure WindowInit;
begin
SetRect(r, 100, 50, 300, 250);
w := NewWindow(nil, r, 'Study', true, zoomDocProc, WindowPtr(-1), false, 0);
SetPort(w);
end;
{>>}
procedure ClearScreen;
var
size: Rect;
begin
SetRect(size, 0, 0, 200, 200);
FillRect(size, white);
end;
{>>}
procedure Redraw;
begin
ClearScreen;
LookAt(Long2Fix(-50), Long2Fix(50), Long2Fix(50), Long2Fix(-50));
ViewAngle(Long2Fix(20));
Identity;
Roll(Long2Fix(hangle));
Pitch(Long2Fix(vangle)); { roll and pitch the plane }
PaintFace;
PaintCube;
PaintAxis(10);
end;
{>>}
procedure WhenDownChanged;
var
hoff, voff: Integer;
begin
hoff := prev.h - cursor.h;
hangle := hangle + hoff;
voff := prev.v - cursor.v;
vangle := vangle + voff;
Redraw;
GetMouse(prev);
end;
{>>}
procedure WhenDown;
begin
GetMouse(cursor);
if cursor.h <> prev.h then
if cursor.v <> prev.v then
WhenDownChanged;
end;
{>>}
procedure MainLoop;
begin
repeat {Until we click outside screen}
while button do
begin
GetMouse(cursor);
GetMouse(prev);
repeat {Tight loop until button up}
WhenDown;
until not Button;
end;
until cursor.h < 0;
end;
begin
WindowInit;
InitGrf3D(nil);
Open3DPort(@myPort3D);
ViewPort(thePort^.portRect);
CreateCube;
Redraw;
MainLoop;
end.

248
examples/3d.checkboard.pas Normal file
View File

@ -0,0 +1,248 @@
program Boxes;
uses
FixMath, Graf3D;
type
Link3D = record
a: Integer;
b: Integer;
end;
var
w: WindowPtr; {A window to draw in}
r: Rect; {A window Size}
myPort: GrafPort;
myPort3D: Port3D;
pa, pb: Point3D;
hangle, vangle: Longint;
{cursor}
cursor, prev: Point;
isDown: Boolean;
{cube}
shape: array[1..9] of Point3D;
links: array[1..13] of Link3D;
{>>}
procedure SetLk3D (var lk3D: Link3D; a, b: Integer);
begin
lk3D.a := a;
lk3D.b := b;
end;
{>>}
procedure CreateCube;
begin
SetPt3D(shape[1], Long2Fix(20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[2], Long2Fix(20), Long2Fix(40), Long2Fix(-20));
SetPt3D(shape[3], Long2Fix(-20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[4], Long2Fix(-20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[5], Long2Fix(20), Long2Fix(-20), Long2Fix(20));
SetPt3D(shape[6], Long2Fix(20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[7], Long2Fix(-20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[8], Long2Fix(-20), Long2Fix(-20), Long2Fix(20));
SetLk3D(links[1], 1, 2);
SetLk3D(links[2], 2, 3);
SetLk3D(links[3], 3, 4);
SetLk3D(links[4], 4, 1);
SetLk3D(links[5], 5, 6);
SetLk3D(links[6], 6, 7);
SetLk3D(links[7], 7, 8);
SetLk3D(links[8], 8, 5);
SetLk3D(links[9], 1, 5);
SetLk3D(links[10], 2, 6);
SetLk3D(links[11], 3, 7);
SetLk3D(links[12], 4, 8);
end;
{>>}
procedure PaintCube;
var
i: Integer;
begin
for i := 1 to 12 do
begin
MoveTo3D(shape[links[i].a].x, shape[links[i].a].y, shape[links[i].a].z);
LineTo3D(shape[links[i].b].x, shape[links[i].b].y, shape[links[i].b].z);
end;
end;
{>>}
function Interpolate (a, b, t: Fixed): Fixed;
begin
Interpolate := a + FixMul(b - a, t);
end;
{>>}
function HasPixel3D (col, row: Integer): Boolean;
begin
HasPixel3D := ((col + (row mod 2 + 1)) mod 2 = 0)
end;
{>>}
procedure LerpPt (var dest, a, b: Point3D; t: Fixed);
begin
SetPt3D(dest, Interpolate(a.x, b.x, t), Interpolate(a.y, b.y, t), Interpolate(a.z, b.z, t))
end;
{>>}
procedure ToPlane (var dest, a, b, c, d: Point3D; col, row, limit: Integer);
var
top, bottom, left, right, result1, result2: Point3D;
begin
LerpPt(top, a, b, FixRatio(row, limit));
LerpPt(bottom, d, c, FixRatio(row, limit));
LerpPt(left, a, d, FixRatio(col, limit));
LerpPt(right, b, c, FixRatio(col, limit));
LerpPt(result1, top, bottom, FixRatio(col, limit));
LerpPt(result2, left, right, FixRatio(row, limit));
LerpPt(dest, result1, result2, FixRatio(col, 2));
end;
{>>}
procedure PaintFace (a, b, c, d: Point3D);
var
tempRgn: RgnHandle;
row, col: Integer;
hpt, vpt, minia, minib, minic, minid: Point3D;
x, y, z: Fixed;
limit: Integer;
begin
limit := 10;
tempRgn := NewRgn;
OpenRgn;
for col := 0 to limit - 1 do
begin
row := 0;
for row := 0 to limit - 1 do
begin
if HasPixel3D(col, row) then
begin
ToPlane(minia, a, b, c, d, row, col, limit);
ToPlane(minib, a, b, c, d, row + 1, col, limit);
ToPlane(minic, a, b, c, d, row, col + 1, limit);
ToPlane(minid, a, b, c, d, row + 1, col + 1, limit);
MoveTo3D(minia.x, minia.y, minia.z);
LineTo3D(minib.x, minib.y, minib.z);
LineTo3D(minid.x, minid.y, minid.z);
LineTo3D(minic.x, minic.y, minic.z);
LineTo3D(minia.x, minia.y, minia.z);
end;
end;
end;
CloseRgn(tempRgn);
PaintRgn(tempRgn);
DisposeRgn(tempRgn);
end;
{>>}
procedure PaintAxis (size: Integer);
begin
PenPat(black);
MoveTo3D(0, 0, 0);
LineTo3D(Long2Fix(size), 0, 0);
WriteDraw('x');
MoveTo3D(0, 0, 0);
LineTo3D(0, Long2Fix(size), 0);
WriteDraw('y');
MoveTo3D(0, 0, 0);
LineTo3D(0, 0, Long2Fix(size));
WriteDraw('z');
end;
{>>}
procedure WindowInit;
begin
SetRect(r, 100, 50, 300, 250);
w := NewWindow(nil, r, 'Mapping', true, zoomDocProc, WindowPtr(-1), false, 0);
SetPort(w);
end;
{>>}
procedure ClearScreen;
var
size: Rect;
begin
SetRect(size, 0, 0, 200, 200);
FillRect(size, white);
end;
{>>}
procedure Redraw;
begin
ClearScreen;
LookAt(Long2Fix(-50), Long2Fix(50), Long2Fix(50), Long2Fix(-50));
ViewAngle(Long2Fix(20));
Identity;
Roll(Long2Fix(hangle));
Pitch(Long2Fix(vangle)); { roll and pitch the plane }
PaintAxis(10);
PaintFace(shape[1], shape[2], shape[3], shape[4]);
PaintCube;
end;
{>>}
procedure WhenDownChanged;
var
hoff, voff: Integer;
begin
hoff := prev.h - cursor.h;
hangle := hangle + hoff;
voff := prev.v - cursor.v;
vangle := vangle + voff;
Redraw;
GetMouse(prev);
end;
{>>}
procedure WhenDown;
begin
GetMouse(cursor);
if cursor.h <> prev.h then
if cursor.v <> prev.v then
WhenDownChanged;
end;
{>>}
procedure MainLoop;
begin
repeat {Until we click outside screen}
while button do
begin
GetMouse(cursor);
GetMouse(prev);
repeat {Tight loop until button up}
WhenDown;
until not Button;
end;
until cursor.h < 0;
end;
begin
WindowInit;
InitGrf3D(nil);
Open3DPort(@myPort3D);
ViewPort(thePort^.portRect);
CreateCube;
hangle := 145;
vangle := 65;
Redraw;
MainLoop;
end.

195
examples/3d.interpolate.pas Normal file
View File

@ -0,0 +1,195 @@
program Boxes;
uses
FixMath, Graf3D;
type
Link3D = record
a: Integer;
b: Integer;
end;
var
w: WindowPtr; {A window to draw in}
r: Rect; {A window Size}
myPort: GrafPort;
myPort3D: Port3D;
pa, pb: Point3D;
hangle, vangle: Longint;
{cursor}
cursor, prev: Point;
isDown: Boolean;
{cube}
shape: array[1..9] of Point3D;
links: array[1..13] of Link3D;
{>>}
procedure SetLk3D (var lk3D: Link3D; a, b: Integer);
begin
lk3D.a := a;
lk3D.b := b;
end;
{>>}
procedure CreateCube;
begin
SetPt3D(shape[1], Long2Fix(20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[2], Long2Fix(20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[3], Long2Fix(-20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[4], Long2Fix(-20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[5], Long2Fix(20), Long2Fix(-20), Long2Fix(20));
SetPt3D(shape[6], Long2Fix(20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[7], Long2Fix(-20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[8], Long2Fix(-20), Long2Fix(-20), Long2Fix(20));
SetLk3D(links[1], 1, 2);
SetLk3D(links[2], 2, 3);
SetLk3D(links[3], 3, 4);
SetLk3D(links[4], 4, 1);
SetLk3D(links[5], 5, 6);
SetLk3D(links[6], 6, 7);
SetLk3D(links[7], 7, 8);
SetLk3D(links[8], 8, 5);
SetLk3D(links[9], 1, 5);
SetLk3D(links[10], 2, 6);
SetLk3D(links[11], 3, 7);
SetLk3D(links[12], 4, 8);
end;
{>>}
procedure PaintCube;
var
i: Integer;
begin
for i := 1 to 12 do
begin
MoveTo3D(shape[links[i].a].x, shape[links[i].a].y, shape[links[i].a].z);
LineTo3D(shape[links[i].b].x, shape[links[i].b].y, shape[links[i].b].z);
end;
end;
{>>}
function Interpolate (a, b, t: Fixed): Fixed;
begin
Interpolate := a + FixMul(b - a, t);
end;
{>>}
procedure LerpPt (var dest, a, b: Point3D; t: Fixed);
begin
SetPt3D(dest, Interpolate(a.x, b.x, t), Interpolate(a.y, b.y, t), Interpolate(a.z, b.z, t))
end;
{>>}
procedure PaintFace (a, b, c, d: Point3D);
var
tempRgn: RgnHandle;
id, row, col, subs: Integer;
minia: Point3D;
begin
LerpPt(minia, a, b, FixRatio(2, 4));
MoveTo3D(minia.x, minia.y, minia.z);
LineTo3D(c.x, c.y, c.z);
end;
{>>}
procedure PaintAxis (size: Integer);
begin
PenPat(black);
MoveTo3D(0, 0, 0);
LineTo3D(Long2Fix(size), 0, 0);
WriteDraw('x');
MoveTo3D(0, 0, 0);
LineTo3D(0, Long2Fix(size), 0);
WriteDraw('y');
MoveTo3D(0, 0, 0);
LineTo3D(0, 0, Long2Fix(size));
WriteDraw('z');
end;
{>>}
procedure WindowInit;
begin
SetRect(r, 100, 50, 300, 250);
w := NewWindow(nil, r, 'Study', true, zoomDocProc, WindowPtr(-1), false, 0);
SetPort(w);
end;
{>>}
procedure ClearScreen;
var
size: Rect;
begin
SetRect(size, 0, 0, 200, 200);
FillRect(size, white);
end;
{>>}
procedure Redraw;
begin
ClearScreen;
LookAt(Long2Fix(-50), Long2Fix(50), Long2Fix(50), Long2Fix(-50));
ViewAngle(Long2Fix(20));
Identity;
Roll(Long2Fix(hangle));
Pitch(Long2Fix(vangle)); { roll and pitch the plane }
PaintFace(shape[1], shape[2], shape[3], shape[4]);
PaintCube;
PaintAxis(10);
end;
{>>}
procedure WhenDownChanged;
var
hoff, voff: Integer;
begin
hoff := prev.h - cursor.h;
hangle := hangle + hoff;
voff := prev.v - cursor.v;
vangle := vangle + voff;
Redraw;
GetMouse(prev);
end;
{>>}
procedure WhenDown;
begin
GetMouse(cursor);
if cursor.h <> prev.h then
if cursor.v <> prev.v then
WhenDownChanged;
end;
{>>}
procedure MainLoop;
begin
repeat {Until we click outside screen}
while button do
begin
GetMouse(cursor);
GetMouse(prev);
repeat {Tight loop until button up}
WhenDown;
until not Button;
end;
until cursor.h < 0;
end;
begin
WindowInit;
InitGrf3D(nil);
Open3DPort(@myPort3D);
ViewPort(thePort^.portRect);
CreateCube;
Redraw;
MainLoop;
end.

268
examples/3d.macintosh.pas Normal file
View File

@ -0,0 +1,268 @@
program Boxes;
uses
FixMath, Graf3D;
type
Link3D = record
a: Integer;
b: Integer;
end;
var
w: WindowPtr; {A window to draw in}
r: Rect; {A window Size}
myPort: GrafPort;
myPort3D: Port3D;
pa, pb: Point3D;
hangle, vangle: Longint;
{cursor}
cursor, prev: Point;
isDown: Boolean;
{cube}
shape: array[1..42] of Point3D;
links: array[1..56] of Link3D;
{>>}
procedure SetLk3D (var lk3D: Link3D; a, b: Integer);
begin
lk3D.a := a;
lk3D.b := b;
end;
{>>}
procedure CreateCube;
begin
SetPt3D(shape[1], Long2Fix(-60), Long2Fix(-80), Long2Fix(45));
SetPt3D(shape[2], Long2Fix(-60), Long2Fix(-50), Long2Fix(65));
SetPt3D(shape[3], Long2Fix(-60), Long2Fix(80), Long2Fix(65));
SetPt3D(shape[4], Long2Fix(-60), Long2Fix(80), Long2Fix(-55));
SetPt3D(shape[5], Long2Fix(-60), Long2Fix(60), Long2Fix(-55));
SetPt3D(shape[6], Long2Fix(-60), Long2Fix(60), Long2Fix(-70));
SetPt3D(shape[7], Long2Fix(60), Long2Fix(-80), Long2Fix(-70));
SetPt3D(shape[8], Long2Fix(60), Long2Fix(-80), Long2Fix(45));
SetPt3D(shape[9], Long2Fix(60), Long2Fix(-50), Long2Fix(65));
SetPt3D(shape[10], Long2Fix(60), Long2Fix(80), Long2Fix(65));
SetPt3D(shape[11], Long2Fix(60), Long2Fix(80), Long2Fix(-55));
SetPt3D(shape[12], Long2Fix(60), Long2Fix(60), Long2Fix(-55));
SetPt3D(shape[13], Long2Fix(60), Long2Fix(60), Long2Fix(-70));
SetPt3D(shape[14], Long2Fix(-25), Long2Fix(-50), Long2Fix(65));
SetPt3D(shape[15], Long2Fix(-25), Long2Fix(-60), Long2Fix(-10));
SetPt3D(shape[16], Long2Fix(-25), Long2Fix(-80), Long2Fix(-10));
SetPt3D(shape[17], Long2Fix(-25), Long2Fix(-80), Long2Fix(45));
SetPt3D(shape[18], Long2Fix(25), Long2Fix(-50), Long2Fix(65));
SetPt3D(shape[19], Long2Fix(25), Long2Fix(-60), Long2Fix(-10));
SetPt3D(shape[20], Long2Fix(25), Long2Fix(-80), Long2Fix(-10));
SetPt3D(shape[21], Long2Fix(25), Long2Fix(-80), Long2Fix(45));
SetPt3D(shape[22], Long2Fix(-50), Long2Fix(-65), Long2Fix(-70));
SetPt3D(shape[23], Long2Fix(50), Long2Fix(-65), Long2Fix(-70));
SetPt3D(shape[24], Long2Fix(50), Long2Fix(10), Long2Fix(-70));
SetPt3D(shape[25], Long2Fix(-50), Long2Fix(10), Long2Fix(-70));
SetPt3D(shape[26], Long2Fix(-45), Long2Fix(-60), Long2Fix(-63));
SetPt3D(shape[27], Long2Fix(45), Long2Fix(-60), Long2Fix(-63));
SetPt3D(shape[28], Long2Fix(45), Long2Fix(5), Long2Fix(-63));
SetPt3D(shape[29], Long2Fix(-45), Long2Fix(5), Long2Fix(-63));
SetPt3D(shape[30], Long2Fix(50), Long2Fix(22), Long2Fix(-70));
SetPt3D(shape[31], Long2Fix(30), Long2Fix(22), Long2Fix(-70));
SetPt3D(shape[32], Long2Fix(30), Long2Fix(25), Long2Fix(-70));
SetPt3D(shape[33], Long2Fix(-5), Long2Fix(25), Long2Fix(-70));
SetPt3D(shape[34], Long2Fix(-5), Long2Fix(32), Long2Fix(-70));
SetPt3D(shape[35], Long2Fix(30), Long2Fix(32), Long2Fix(-70));
SetPt3D(shape[36], Long2Fix(30), Long2Fix(35), Long2Fix(-70));
SetPt3D(shape[37], Long2Fix(50), Long2Fix(35), Long2Fix(-70));
SetPt3D(shape[38], Long2Fix(-50), Long2Fix(32), Long2Fix(-70));
SetPt3D(shape[39], Long2Fix(-37), Long2Fix(32), Long2Fix(-70));
SetPt3D(shape[40], Long2Fix(-37), Long2Fix(45), Long2Fix(-70));
SetPt3D(shape[41], Long2Fix(-50), Long2Fix(45), Long2Fix(-70));
SetPt3D(shape[42], Long2Fix(-60), Long2Fix(-80), Long2Fix(-70));
SetLk3D(links[1], 42, 1);
SetLk3D(links[2], 1, 2);
SetLk3D(links[3], 2, 3);
SetLk3D(links[4], 3, 4);
SetLk3D(links[5], 4, 5);
SetLk3D(links[6], 5, 6);
SetLk3D(links[7], 6, 42);
SetLk3D(links[8], 7, 8);
SetLk3D(links[9], 8, 9);
SetLk3D(links[10], 9, 10);
SetLk3D(links[11], 10, 11);
SetLk3D(links[12], 11, 12);
SetLk3D(links[13], 12, 13);
SetLk3D(links[14], 13, 7);
SetLk3D(links[15], 42, 7);
SetLk3D(links[16], 2, 9);
SetLk3D(links[17], 3, 10);
SetLk3D(links[18], 4, 11);
SetLk3D(links[19], 5, 12);
SetLk3D(links[20], 6, 13);
SetLk3D(links[21], 14, 15);
SetLk3D(links[22], 15, 16);
SetLk3D(links[23], 16, 17);
SetLk3D(links[24], 17, 14);
SetLk3D(links[25], 18, 19);
SetLk3D(links[26], 19, 20);
SetLk3D(links[27], 20, 21);
SetLk3D(links[28], 21, 18);
SetLk3D(links[29], 17, 1);
SetLk3D(links[30], 21, 8);
SetLk3D(links[31], 15, 19);
SetLk3D(links[32], 16, 20);
SetLk3D(links[33], 22, 23);
SetLk3D(links[34], 23, 24);
SetLk3D(links[35], 24, 25);
SetLk3D(links[36], 25, 22);
SetLk3D(links[37], 26, 27);
SetLk3D(links[38], 27, 28);
SetLk3D(links[39], 28, 29);
SetLk3D(links[40], 29, 26);
SetLk3D(links[41], 22, 26);
SetLk3D(links[42], 23, 27);
SetLk3D(links[43], 24, 28);
SetLk3D(links[44], 25, 29);
SetLk3D(links[45], 30, 31);
SetLk3D(links[46], 31, 32);
SetLk3D(links[47], 32, 33);
SetLk3D(links[48], 33, 34);
SetLk3D(links[49], 34, 35);
SetLk3D(links[50], 35, 36);
SetLk3D(links[51], 36, 37);
SetLk3D(links[52], 37, 30);
SetLk3D(links[53], 38, 39);
SetLk3D(links[54], 39, 40);
SetLk3D(links[55], 40, 41);
SetLk3D(links[56], 41, 38);
end;
{>>}
procedure PaintCube;
var
i: Integer;
begin
for i := 1 to 56 do
begin
MoveTo3D(shape[links[i].a].x, shape[links[i].a].y, shape[links[i].a].z);
LineTo3D(shape[links[i].b].x, shape[links[i].b].y, shape[links[i].b].z);
end;
end;
{>>}
procedure PaintFace;
var
tempRgn: RgnHandle;
begin
tempRgn := NewRgn;
OpenRgn;
MoveTo3D(shape[26].x, shape[26].Y, shape[26].Z);
LineTo3D(shape[27].X, shape[27].Y, shape[27].Z);
LineTo3D(shape[28].X, shape[28].Y, shape[28].Z);
LineTo3D(shape[29].X, shape[29].Y, shape[29].Z);
LineTo3D(shape[26].X, shape[26].Y, shape[26].Z);
CloseRgn(tempRgn);
FillRgn(tempRgn, ltgray);
DisposeRgn(tempRgn);
end;
{>>}
procedure PaintInspector (pt3D: Point3D);
begin
MoveTo3D(pt3D.x, pt3D.y, pt3D.z);
Line2D(pt3D.x + 5, pt3D.y);
end;
{>>}
procedure PaintAxis (size: Integer);
begin
PenPat(black);
MoveTo3D(0, 0, 0);
LineTo3D(Long2Fix(size), 0, 0);
WriteDraw('x');
MoveTo3D(0, 0, 0);
LineTo3D(0, Long2Fix(size), 0);
WriteDraw('y');
MoveTo3D(0, 0, 0);
LineTo3D(0, 0, Long2Fix(size));
WriteDraw('z');
end;
{>>}
procedure WindowInit;
begin
SetRect(r, 100, 50, 300, 250);
w := NewWindow(nil, r, 'Study', true, zoomDocProc, WindowPtr(-1), false, 0);
SetPort(w);
end;
{>>}
procedure ClearScreen;
var
size: Rect;
begin
SetRect(size, 0, 0, 200, 200);
FillRect(size, white);
end;
{>>}
procedure Redraw;
begin
ClearScreen;
LookAt(Long2Fix(-200), Long2Fix(200), Long2Fix(200), Long2Fix(-200));
ViewAngle(Long2Fix(50));
Identity;
Roll(Long2Fix(hangle));
Pitch(Long2Fix(vangle)); { roll and pitch the plane }
PaintFace;
PaintCube;
end;
{>>}
procedure WhenDownChanged;
var
hoff, voff: Integer;
begin
hoff := prev.h - cursor.h;
hangle := hangle + hoff;
voff := prev.v - cursor.v;
vangle := vangle + voff;
Redraw;
GetMouse(prev);
end;
{>>}
procedure WhenDown;
begin
GetMouse(cursor);
if cursor.h <> prev.h then
if cursor.v <> prev.v then
WhenDownChanged;
end;
{>>}
procedure MainLoop;
begin
repeat {Until we click outside screen}
while button do
begin
GetMouse(cursor);
GetMouse(prev);
repeat {Tight loop until button up}
WhenDown;
until not Button;
end;
until cursor.h < 0;
end;
begin
WindowInit;
InitGrf3D(nil);
Open3DPort(@myPort3D);
ViewPort(thePort^.portRect);
CreateCube;
Redraw;
MainLoop;
end.

99
examples/3d.normals.pas Normal file
View File

@ -0,0 +1,99 @@
program ExampleNormals;
uses
FixMath, Graf3D;
var
w: WindowPtr; {A window to draw in}
r: Rect; {A window Size}
myPort: GrafPort;
myPort3D: Port3D;
i: INTEGER;
dummy: EventRecord;
pa, pb: Point3D;
{>>}
procedure WindowInit;
begin
SetRect(r, 100, 50, 550, 400);
w := NewWindow(nil, r, 'Color Cube', true, zoomDocProc, WindowPtr(-1), false, 0);
SetPort(w);
end;
{>>}
procedure MainLoop;
begin
repeat
until button;
end;
{>>}
procedure DrawBrick (pt1, pt2: Point3D);
var
tempRgn: RgnHandle;
begin
tempRgn := NewRgn;
ForeColor(blueColor);
BackColor(yellowColor);
OpenRgn;
MoveTo3D(pt1.X, pt1.Y, pt1.Z); { front face, y=y1 }
LineTo3D(pt1.X, pt1.Y, pt2.Z);
LineTo3D(pt2.X, pt1.Y, pt2.Z);
LineTo3D(pt2.X, pt1.Y, pt1.Z);
LineTo3D(pt1.X, pt1.Y, pt1.Z);
CloseRgn(tempRgn);
FillRgn(tempRgn, ltgray);
ForeColor(redColor);
BackColor(cyanColor);
OpenRgn;
MoveTo3D(pt1.X, pt1.Y, pt2.Z); { top face, z=z2 }
LineTo3D(pt1.X, pt2.Y, pt2.Z);
LineTo3D(pt2.X, pt2.Y, pt2.Z);
LineTo3D(pt2.X, pt1.Y, pt2.Z);
LineTo3D(pt1.X, pt1.Y, pt2.Z);
CloseRgn(tempRgn);
FillRgn(tempRgn, ltgray);
ForeColor(greenColor);
BackColor(magentaColor);
OpenRgn;
MoveTo3D(pt2.X, pt1.Y, pt1.Z); { right face, x=x2 }
LineTo3D(pt2.X, pt1.Y, pt2.Z);
LineTo3D(pt2.X, pt2.Y, pt2.Z);
LineTo3D(pt2.X, pt2.Y, pt1.Z);
LineTo3D(pt2.X, pt1.Y, pt1.Z);
CloseRgn(tempRgn);
FillRgn(tempRgn, ltgray);
PenPat(white);
MoveTo3D(pt2.X, pt2.Y, pt2.Z); { outline right }
LineTo3D(pt2.X, pt2.Y, pt1.Z);
LineTo3D(pt2.X, pt1.Y, pt1.Z);
PenNormal;
DisposeRgn(tempRgn);
end;
begin
WindowInit;
InitGrf3D(nil);
Open3DPort(@myPort3D);
{ camera }
ViewPort(thePort^.portRect);
LookAt(Long2Fix(-100), Long2Fix(100), Long2Fix(100), Long2Fix(-100));
ViewAngle(Long2Fix(20));
Identity;
Roll(Long2Fix(20));
Pitch(Long2Fix(70)); { roll and pitch the plane }
SetPt3D(pa, Long2Fix(20), Long2Fix(20), Long2Fix(20));
SetPt3D(pb, Long2Fix(-20), Long2Fix(-20), Long2Fix(-20));
DrawBrick(pa, pb);
MainLoop;
end.

169
examples/3d.rotate.pas Normal file
View File

@ -0,0 +1,169 @@
program Boxes;
uses
FixMath, Graf3D;
type
Link3D = record
a: Integer;
b: Integer;
end;
var
w: WindowPtr; {A window to draw in}
r: Rect; {A window Size}
myPort: GrafPort;
myPort3D: Port3D;
pa, pb: Point3D;
hangle, vangle: Longint;
{cursor}
cursor, prev: Point;
isDown: Boolean;
{cube}
shape: array[1..9] of Point3D;
links: array[1..13] of Link3D;
{>>}
procedure SetLk3D (var lk3D: Link3D; a, b: Integer);
begin
lk3D.a := a;
lk3D.b := b;
end;
{>>}
procedure CreateCube;
begin
SetPt3D(shape[1], Long2Fix(20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[2], Long2Fix(20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[3], Long2Fix(-20), Long2Fix(20), Long2Fix(-20));
SetPt3D(shape[4], Long2Fix(-20), Long2Fix(20), Long2Fix(20));
SetPt3D(shape[5], Long2Fix(20), Long2Fix(-20), Long2Fix(20));
SetPt3D(shape[6], Long2Fix(20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[7], Long2Fix(-20), Long2Fix(-20), Long2Fix(-20));
SetPt3D(shape[8], Long2Fix(-20), Long2Fix(-20), Long2Fix(20));
SetLk3D(links[1], 1, 2);
SetLk3D(links[2], 2, 3);
SetLk3D(links[3], 3, 4);
SetLk3D(links[4], 4, 1);
SetLk3D(links[5], 5, 6);
SetLk3D(links[6], 6, 7);
SetLk3D(links[7], 7, 8);
SetLk3D(links[8], 8, 5);
SetLk3D(links[9], 1, 5);
SetLk3D(links[10], 2, 6);
SetLk3D(links[11], 3, 7);
SetLk3D(links[12], 4, 8);
end;
{>>}
procedure PaintCube;
var
i: Integer;
begin
for i := 1 to 12 do
begin
MoveTo3D(shape[links[i].a].x, shape[links[i].a].y, shape[links[i].a].z);
LineTo3D(shape[links[i].b].x, shape[links[i].b].y, shape[links[i].b].z);
end;
end;
{>>}
procedure PaintAxis (size: Integer);
begin
PenPat(black);
MoveTo3D(0, 0, 0);
LineTo3D(Long2Fix(size), 0, 0);
WriteDraw('x');
MoveTo3D(0, 0, 0);
LineTo3D(0, Long2Fix(size), 0);
WriteDraw('y');
MoveTo3D(0, 0, 0);
LineTo3D(0, 0, Long2Fix(size));
WriteDraw('z');
end;
{>>}
procedure WindowInit;
begin
SetRect(r, 100, 50, 300, 250);
w := NewWindow(nil, r, 'Study', true, zoomDocProc, WindowPtr(-1), false, 0);
SetPort(w);
end;
{>>}
procedure ClearScreen;
var
size: Rect;
begin
SetRect(size, 0, 0, 200, 200);
FillRect(size, white);
end;
{>>}
procedure Redraw;
begin
ClearScreen;
LookAt(Long2Fix(-50), Long2Fix(50), Long2Fix(50), Long2Fix(-50));
ViewAngle(Long2Fix(20));
Identity;
Roll(Long2Fix(hangle));
Pitch(Long2Fix(vangle)); { roll and pitch the plane }
PaintAxis(10);
PaintCube;
end;
{>>}
procedure WhenDownChanged;
var
hoff, voff: Integer;
begin
hoff := prev.h - cursor.h;
hangle := hangle + hoff;
voff := prev.v - cursor.v;
vangle := vangle + voff;
Redraw;
GetMouse(prev);
end;
{>>}
procedure WhenDown;
begin
GetMouse(cursor);
if cursor.h <> prev.h then
if cursor.v <> prev.v then
WhenDownChanged;
end;
{>>}
procedure MainLoop;
begin
repeat {Until we click outside screen}
while button do
begin
GetMouse(cursor);
GetMouse(prev);
repeat {Tight loop until button up}
WhenDown;
until not Button;
end;
until cursor.h < 0;
end;
begin
WindowInit;
InitGrf3D(nil);
Open3DPort(@myPort3D);
ViewPort(thePort^.portRect);
CreateCube;
Redraw;
MainLoop;
end.

26
examples/angle.pas Normal file
View File

@ -0,0 +1,26 @@
program ExampleAngle;
var
ax, ay, bx, by, angle, length, t: Real;
begin
angle := 45;
length := 100;
ax := 50;
ay := 50;
t := angle * PI / 180;
bx := ax + length * cos(t);
by := ay + length * sin(t);
ShowDrawing;
{ origin }
MoveTo(round(ax), round(ay));
LineTo(round(ax + 100), round(ay));
{ offset }
MoveTo(round(ax), round(ay));
LineTo(round(bx), round(by));
end.

26
examples/around.pas Normal file