mirror of
https://git.sr.ht/~rabbits/macintosh_cookbook
synced 2024-09-29 09:55:06 +00:00
Updated readme
This commit is contained in:
commit
e592018aeb
7
README.md
Normal file
7
README.md
Normal 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
63071
docs/macintosh inside.html
Normal file
File diff suppressed because it is too large
Load Diff
222
docs/pascal quickdraw.html
Normal file
222
docs/pascal quickdraw.html
Normal 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
186
examples/3d.box.pas
Normal 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
248
examples/3d.checkboard.pas
Normal 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
195
examples/3d.interpolate.pas
Normal 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
268
examples/3d.macintosh.pas
Normal 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
99
examples/3d.normals.pas
Normal 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
169
examples/3d.rotate.pas
Normal 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
26
examples/angle.pas
Normal 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
26
examples/around.pas
Normal file
@ -0,0 +1,26 @@
|
||||
program ExampleAround;
|
||||
|
||||
var
|
||||
count, countup, countdown: Integer;
|
||||
box: rect;
|
||||
|
||||
begin
|
||||
|
||||
{ Create the window rect }
|
||||
SetRect(box, 100, 100, 320, 320);
|
||||
SetDrawingRect(box);
|
||||
ShowDrawing;
|
||||
|
||||
{ Draw lines }
|
||||
for count := 0 to 20 do
|
||||
begin
|
||||
countup := count * 4;
|
||||
countdown := 200 - countup;
|
||||
Moveto(countup, 0);
|
||||
Lineto(200, countup);
|
||||
Lineto(countdown, 200);
|
||||
Lineto(0, countdown);
|
||||
Lineto(countup, 0);
|
||||
end
|
||||
|
||||
end.
|
49
examples/ball.pas
Normal file
49
examples/ball.pas
Normal file
@ -0,0 +1,49 @@
|
||||
program ExampleBall;
|
||||
|
||||
const
|
||||
PICTURE_HEIGHT = 100;
|
||||
PICTURE_WIDTH = 400;
|
||||
BALL_SIZE = 8;
|
||||
GRAVITY = -0.5;
|
||||
BOUNCINESS = 0.9;
|
||||
COURT_LEVEL = 100;
|
||||
var
|
||||
Horizontal_Position: Integer;
|
||||
Vertical_Position, Velocity: Real;
|
||||
drawingRect, ovalRect: Rect;
|
||||
|
||||
procedure DrawBall (Vertical_Position: Integer);
|
||||
var
|
||||
Top, Left, Bottom, Right: Integer;
|
||||
begin
|
||||
Top := COURT_LEVEL - Vertical_Position - BALL_SIZE;
|
||||
Left := Horizontal_Position - BALL_SIZE;
|
||||
Bottom := COURT_LEVEL - Vertical_Position + BALL_SIZE;
|
||||
Right := Horizontal_Position + BALL_SIZE;
|
||||
SetRect(ovalRect, Left, Top, Right, Bottom);
|
||||
FrameOval(ovalRect);
|
||||
end;
|
||||
|
||||
begin {bouncing ball}
|
||||
|
||||
ShowDrawing;
|
||||
SetRect(drawingRect, 60, 60, 80 + PICTURE_WIDTH, 80 + PICTURE_HEIGHT);
|
||||
SetDrawingRect(drawingRect);
|
||||
|
||||
Horizontal_Position := BALL_SIZE + 1;
|
||||
Vertical_Position := PICTURE_HEIGHT - BALL_SIZE - 1;
|
||||
Velocity := 0;
|
||||
DrawBall(round(Vertical_Position));
|
||||
repeat
|
||||
Horizontal_Position := Horizontal_Position + 2;
|
||||
Velocity := Velocity + GRAVITY;
|
||||
Vertical_Position := Vertical_Position + Velocity;
|
||||
if Vertical_Position <= 0 then
|
||||
begin
|
||||
Vertical_Position := Abs(Vertical_Position);
|
||||
Velocity := -(BOUNCINESS * Velocity);
|
||||
end;
|
||||
DrawBall(round(Vertical_Position));
|
||||
until Horizontal_Position >= PICTURE_WIDTH;
|
||||
|
||||
end.
|
113
examples/bezier.pas
Normal file
113
examples/bezier.pas
Normal file
@ -0,0 +1,113 @@
|
||||
program ExampleBezier;
|
||||
|
||||
type
|
||||
mat = array[1..4, 1..4] of Real;
|
||||
|
||||
var
|
||||
Px, Py, Cx, Cy: mat;
|
||||
Tv, Mb, x, y: mat;
|
||||
i, j, k, xx, yy: Integer;
|
||||
window: rect;
|
||||
t, dt: Real;
|
||||
P: point;
|
||||
|
||||
procedure matmlt (var d, a, b: mat; n, m: integer);
|
||||
var
|
||||
i, j, k: Integer;
|
||||
sum: Real;
|
||||
temp: mat;
|
||||
begin
|
||||
for i := 1 to n do
|
||||
begin
|
||||
for j := 1 to m do
|
||||
begin
|
||||
sum := 0.0;
|
||||
for k := 1 to 4 do
|
||||
sum := sum + a[i, k] * b[k, j];
|
||||
temp[i, j] := sum;
|
||||
end;
|
||||
end;
|
||||
for i := 1 to n do
|
||||
for j := 1 to m do
|
||||
d[i, j] := temp[i, j];
|
||||
end;
|
||||
|
||||
procedure getPoints;
|
||||
var
|
||||
i, x, y: Integer;
|
||||
begin
|
||||
SetRect(window, 30, 30, 400, 300);
|
||||
setDrawingRect(window);
|
||||
ShowDrawing;
|
||||
penSize(2, 2);
|
||||
Moveto(40, 20); {Print heading }
|
||||
textSize(18);
|
||||
textFont(2);
|
||||
writeDraw('Bezier Parametric Cubic Curve');
|
||||
textSize(12);
|
||||
ForeColor(409); {Set pen to blue.}
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
SetRect(window, 90, 30, 255, 50);
|
||||
eraseRect(window);
|
||||
Moveto(100, 45);
|
||||
writeDraw('Please click in point', I : 3);
|
||||
FrameRect(window);
|
||||
repeat
|
||||
getMouse(P)
|
||||
until button;
|
||||
repeat
|
||||
until (not button);
|
||||
Px[i, 1] := P.h;
|
||||
Py[i, 1] := P.v;
|
||||
SetRect(window, (P.h - 2), (P.v - 2), (P.h + 4), (P.v + 4));
|
||||
PaintOval(window);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure set_BezMat;
|
||||
begin
|
||||
Mb[1, 1] := -1;
|
||||
Mb[1, 2] := 3;
|
||||
Mb[1, 3] := -3;
|
||||
Mb[1, 4] := 1;
|
||||
Mb[2, 1] := 3;
|
||||
Mb[2, 2] := -6;
|
||||
Mb[2, 3] := 3;
|
||||
Mb[2, 4] := 0;
|
||||
Mb[3, 1] := -3;
|
||||
Mb[3, 2] := 3;
|
||||
Mb[3, 3] := 0;
|
||||
Mb[3, 4] := 0;
|
||||
Mb[4, 1] := 1;
|
||||
Mb[4, 2] := 0;
|
||||
Mb[4, 3] := 0;
|
||||
Mb[4, 4] := 0;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
set_BezMat;
|
||||
getPoints;
|
||||
matmlt(Cx, Mb, Px, 4, 1);
|
||||
matmlt(Cy, Mb, Py, 4, 1);
|
||||
t := -0.01;
|
||||
xx := round(Px[1, 1]);
|
||||
yy := round(Py[1, 1]);
|
||||
Moveto(xx, yy);
|
||||
ForeColor(137); {Set pen to magenta.}
|
||||
for i := 1 to 101 do
|
||||
begin
|
||||
t := t + 0.01;
|
||||
Tv[1, 4] := 1;
|
||||
Tv[1, 3] := t * Tv[1, 4];
|
||||
Tv[1, 2] := t * Tv[1, 3];
|
||||
Tv[1, 1] := t * Tv[1, 2];
|
||||
matmlt(x, Tv, Cx, 1, 1);
|
||||
matmlt(y, Tv, Cy, 1, 1);
|
||||
xx := round(x[1, 1]);
|
||||
yy := round(y[1, 1]);
|
||||
Lineto(xx, yy);
|
||||
end;
|
||||
|
||||
end.
|
21
examples/bitwise.pas
Normal file
21
examples/bitwise.pas
Normal file
@ -0,0 +1,21 @@
|
||||
program ExampleBitwise;
|
||||
|
||||
var
|
||||
value, mask: Integer;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
|
||||
Writeln(BAnd(20, 123));
|
||||
Writeln(Btst(20, 16));
|
||||
|
||||
{ compare }
|
||||
Writeln(Bxor(20, 123));
|
||||
Writeln(Bor(20, 123));
|
||||
|
||||
{bit shift }
|
||||
Writeln(Bsl(20, 1));
|
||||
Writeln(Bsr(20, 1));
|
||||
|
||||
end.
|
78
examples/bresenham.pas
Normal file
78
examples/bresenham.pas
Normal file
@ -0,0 +1,78 @@
|
||||
program ExampleBresenham;
|
||||
{Program to draw a straight }
|
||||
{ line from (x1,y1) to (x2,y2) }
|
||||
{using Bresenham's Algorithm }
|
||||
var
|
||||
i, irange, xp, yp, dxs, dys: Integer;
|
||||
x1, y1, x2, y2: Real;
|
||||
dx, dy, x, y, range: Real;
|
||||
errp: Real;
|
||||
axis: char;
|
||||
procedure point (x, y: integer);
|
||||
{Procedure to plot point at (x,y)}
|
||||
begin
|
||||
Moveto(xp, yp);
|
||||
Lineto(xp, yp);
|
||||
end;
|
||||
begin
|
||||
{Query the user for two points}
|
||||
Writeln('Bresenham''s Straight-Line Algorithm');
|
||||
Writeln('Input point 1 (x1,y1):');
|
||||
Readln(x1, y1);
|
||||
Writeln('Input point 2 (x2,y2):');
|
||||
Readln(x2, y2);
|
||||
range := abs(x2 - x1);
|
||||
axis := 'x';
|
||||
{Test for axis of more rapid motion}
|
||||
if abs(y2 - y1) > range then
|
||||
begin
|
||||
range := abs(y2 - y1);
|
||||
axis := 'y';
|
||||
end;
|
||||
irange := round(range);
|
||||
dx := (x2 - x1);
|
||||
dy := (y2 - y1);
|
||||
errp := 2 * dy - dx;
|
||||
dxs := 1;
|
||||
{Test for direction of x motion}
|
||||
if dx < 0 then
|
||||
dxs := -1;
|
||||
dys := 1;
|
||||
{Test for direction of y motion}
|
||||
if dy < 0 then
|
||||
dys := -1;
|
||||
xp := round(x1);
|
||||
yp := round(y1);
|
||||
ShowDrawing;
|
||||
{This part steps along x axis}
|
||||
case axis of
|
||||
'x':
|
||||
begin
|
||||
for i := 1 to irange do
|
||||
begin
|
||||
point(xp, yp);
|
||||
if errp > 0 then
|
||||
begin
|
||||
yp := yp + dys;
|
||||
errp := errp - 2 * dx * dxs
|
||||
end;
|
||||
xp := xp + dxs;
|
||||
errp := errp + 2 * dy * dys;
|
||||
end;
|
||||
end;
|
||||
'y': {This part steps along y axis}
|
||||
begin
|
||||
for i := 1 to irange do
|
||||
begin
|
||||
point(xp, yp);
|
||||
if errp > 0 then
|
||||
begin
|
||||
xp := xp + dxs;
|
||||
errp := errp - 2 * dy * dys
|
||||
end;
|
||||
yp := yp + dys;
|
||||
errp := errp + 2 * dx * dxs;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end.
|
86
examples/chaos.pas
Normal file
86
examples/chaos.pas
Normal file
@ -0,0 +1,86 @@
|
||||
program ExampleEulerStorm;
|
||||
|
||||
const
|
||||
A = -1;
|
||||
B = 3;
|
||||
C = -2;
|
||||
D = 5;
|
||||
eps = 0.05;
|
||||
|
||||
var
|
||||
ds: real;
|
||||
|
||||
function f (x, y: real): real;
|
||||
begin
|
||||
f := y - x * x * x / 3
|
||||
end;
|
||||
|
||||
function g (x, y: real): real;
|
||||
begin
|
||||
g := -x
|
||||
end;
|
||||
|
||||
procedure segment (x, y: real);
|
||||
begin
|
||||
LineTo(round(510 * (x - A) / (B - A)), round(340 * (y - D) / (c - d)))
|
||||
end;
|
||||
|
||||
procedure euler (S: integer; var err: boolean; x0, y0: real; var x1, y1: real);
|
||||
var
|
||||
dx, dy, dt: real;
|
||||
begin
|
||||
err := false;
|
||||
dx := f(x0, y0);
|
||||
dy := g(x0, y0);
|
||||
if abs(dx) + abs(dy) < eps then
|
||||
err := true
|
||||
else
|
||||
begin
|
||||
dt := ds / sqrt(dx * dx + dy * dy);
|
||||
x1 := x0 + S * dt * dx;
|
||||
y1 := y0 + S * dt * dy
|
||||
end
|
||||
end;
|
||||
|
||||
procedure trajectory (x, y: real);
|
||||
var
|
||||
N, S: integer;
|
||||
x0, y0, x1, y1: real;
|
||||
msg: boolean;
|
||||
begin
|
||||
for S := 0 to 1 do
|
||||
begin
|
||||
x0 := x;
|
||||
y0 := y;
|
||||
N := 1;
|
||||
MoveTo(round(510 * (x - A) / (B - A)), round(340 * (y - D) / (C - D)));
|
||||
repeat
|
||||
euler(2 * S - 1, msg, x0, y0, x1, y1);
|
||||
if not (msg) then
|
||||
begin
|
||||
segment(x1, y1);
|
||||
N := N + 1;
|
||||
x0 := x1;
|
||||
y0 := y1
|
||||
end
|
||||
until msg or (N > 50) or (x1 < A) or (x1 > B) or (y1 < C) or (y1 > D)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DrawPicture;
|
||||
var
|
||||
i, j, diviseur: integer;
|
||||
begin
|
||||
diviseur := 10;
|
||||
for j := 2 to 5 do
|
||||
for i := 1 to diviseur do
|
||||
trajectory((B + A) / 2 + (B - A) * cos(2 * pi * i / diviseur) / j, (C + D) / 2 + (D - C) * sin(2 * pi * i / diviseur) / j)
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ds := (B - A) / 50;
|
||||
ShowDrawing;
|
||||
DrawPicture;
|
||||
|
||||
end.
|
39
examples/circle.pas
Normal file
39
examples/circle.pas
Normal file
@ -0,0 +1,39 @@
|
||||
program ExampleCircle;
|
||||
|
||||
type
|
||||
Vector2 = record
|
||||
x, y: real
|
||||
end;
|
||||
|
||||
var
|
||||
r: Real;
|
||||
|
||||
procedure Circle (r: real);
|
||||
var
|
||||
theta, thinc: Real;
|
||||
i: Integer;
|
||||
pt: Vector2;
|
||||
begin
|
||||
theta := 0.0;
|
||||
thinc := 2 * pi / 100.0;
|
||||
pt.x := r;
|
||||
pt.y := 0.0;
|
||||
Moveto(round(pt.x), round(pt.y));
|
||||
for i := 1 to 100 do
|
||||
begin
|
||||
theta := theta + thinc;
|
||||
pt.x := r * cos(theta);
|
||||
pt.y := r * sin(theta);
|
||||
Lineto(round(pt.x), round(pt.y));
|
||||
end
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Writeln('Radius:');
|
||||
Readln(r);
|
||||
|
||||
ShowDrawing;
|
||||
Circle(r);
|
||||
|
||||
end.
|
25
examples/circlefill.pas
Normal file
25
examples/circlefill.pas
Normal file
@ -0,0 +1,25 @@
|
||||
program ExampleCircleFill;
|
||||
|
||||
procedure Fillcircle (xc, yc, radius: integer);
|
||||
var
|
||||
x, y: Integer;
|
||||
begin
|
||||
for y := -radius to radius do
|
||||
begin
|
||||
for x := -radius to radius do
|
||||
begin
|
||||
if (x * x + y * y <= radius * radius) then
|
||||
begin
|
||||
Moveto(xc + x, yc + y);
|
||||
Lineto(xc + x, yc + y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
Fillcircle(60, 60, 40);
|
||||
|
||||
end.
|
25
examples/clone.pas
Normal file
25
examples/clone.pas
Normal file
@ -0,0 +1,25 @@
|
||||
program ExampleClone;
|
||||
|
||||
const
|
||||
size = 50;
|
||||
|
||||
var
|
||||
a, b: Rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
SetRect(a, 0, size, size * 2, size * 3);
|
||||
PaintArc(a, 0, 90);
|
||||
SetRect(a, size, size, size * 2, size * 2);
|
||||
b := a;
|
||||
|
||||
OffSetRect(b, size, 0);
|
||||
CopyBits(thePort^.portBits, thePort^.portBits, a, b, srcCopy, nil);
|
||||
OffSetRect(b, 0, size);
|
||||
CopyBits(thePort^.portBits, thePort^.portBits, a, b, srcCopy, nil);
|
||||
|
||||
FrameRect(b);
|
||||
|
||||
end.
|
22
examples/console.pas
Normal file
22
examples/console.pas
Normal file
@ -0,0 +1,22 @@
|
||||
program ExampleConsole;
|
||||
|
||||
const
|
||||
message = ' Welcome to the world of Pascal ';
|
||||
|
||||
type
|
||||
name = String;
|
||||
|
||||
var
|
||||
firstname, surname: name;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
Writeln('Please enter your first name: ');
|
||||
Readln(firstname);
|
||||
Writeln('Please enter your surname: ');
|
||||
Readln(surname);
|
||||
Writeln;
|
||||
Writeln(message, ' ', firstname, ' ', surname);
|
||||
|
||||
end.
|
19
examples/const.pas
Normal file
19
examples/const.pas
Normal file
@ -0,0 +1,19 @@
|
||||
program const_circle (input, output);
|
||||
|
||||
const
|
||||
PI = 3.141592654;
|
||||
|
||||
var
|
||||
r, d, c: Real; {variable declaration: radius, dia, circumference}
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
Writeln('Enter the radius of the circle');
|
||||
Readln(r);
|
||||
|
||||
d := 2 * r;
|
||||
c := PI * d;
|
||||
Writeln('The circumference of the circle is ', c : 7 : 2);
|
||||
|
||||
end.
|
170
examples/cursor.pas
Normal file
170
examples/cursor.pas
Normal file
@ -0,0 +1,170 @@
|
||||
program Showing_Cursors (input, output);
|
||||
|
||||
type
|
||||
Port = GrafPtr;
|
||||
Rect_Table = array[1..3] of Rect;
|
||||
var
|
||||
Rectangle: Rect_Table;
|
||||
Window: Port;
|
||||
J: Integer;
|
||||
Area: array[1..3] of RgnHandle;
|
||||
Smile, Frown, Justso: Cursor;
|
||||
Mousepoint: Point;
|
||||
|
||||
procedure Open_Window (var Viewport: Port);
|
||||
begin
|
||||
new(Viewport);
|
||||
OpenPort(Viewport)
|
||||
end;
|
||||
|
||||
procedure Initialize_Rectangles (var Box: Rect_Table);
|
||||
begin
|
||||
SetRect(Box[1], 0, 0, 512, 342);
|
||||
SetRect(Box[2], 40, 40, 250, 250);
|
||||
SetRect(Box[3], 300, 120, 500, 320);
|
||||
end;
|
||||
|
||||
procedure Dispose_of_Window (var Viewport: Port);
|
||||
begin
|
||||
ClosePort(Viewport);
|
||||
Dispose(Viewport)
|
||||
end;
|
||||
|
||||
procedure Pushbutton;
|
||||
var
|
||||
Time: Longint;
|
||||
begin
|
||||
|
||||
while not Button do { nothing }
|
||||
;
|
||||
Delay(10, Time);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
HideAll;
|
||||
HideCursor;
|
||||
|
||||
{ Initialize the data arrays for the three cursors. }
|
||||
|
||||
Smile.data[0] := 1;
|
||||
Smile.data[1] := -32767;
|
||||
Smile.data[2] := -32767;
|
||||
Smile.data[3] := -26599;
|
||||
Smile.data[4] := -26599;
|
||||
Smile.data[5] := -32767;
|
||||
Smile.data[6] := -32767;
|
||||
Smile.data[7] := -32511;
|
||||
Smile.data[8] := -31871;
|
||||
Smile.data[9] := -32511;
|
||||
Smile.data[10] := -28655;
|
||||
Smile.data[11] := -30687;
|
||||
Smile.data[12] := -31679;
|
||||
Smile.data[13] := -31871;
|
||||
Smile.data[14] := -32767;
|
||||
Smile.data[15] := -1;
|
||||
Smile.hotspot.v := 8;
|
||||
Smile.hotspot.h := 8;
|
||||
Frown.data[0] := -1;
|
||||
Frown.data[1] := -32767;
|
||||
Frown.data[2] := -32767;
|
||||
Frown.data[3] := -26599;
|
||||
Frown.data[4] := -26599;
|
||||
Frown.data[5] := -32767;
|
||||
Frown.data[6] := -32767;
|
||||
Frown.data[7] := -32511;
|
||||
Frown.data[8] := -31871;
|
||||
Frown.data[9] := -32511;
|
||||
Frown.data[10] := -32767;
|
||||
Frown.data[11] := -31871;
|
||||
Frown.data[12] := -31679;
|
||||
Frown.data[13] := -30687;
|
||||
Frown.data[14] := -32767;
|
||||
Frown.data[15] := -1;
|
||||
Frown.hotspot.v := 8;
|
||||
Frown.hotspot.h := 8;
|
||||
Justso.data[0] := -1;
|
||||
Justso.data[1] := -32767;
|
||||
Justso.data[2] := -32767;
|
||||
Justso.data[3] := -26599;
|
||||
Justso.data[4] := -26599;
|
||||
Justso.data[5] := -32767;
|
||||
Justso.data[6] := -32767;
|
||||
Justso.data[7] := -32511;
|
||||
Justso.data[8] := -31871;
|
||||
Justso.data[9] := -32511;
|
||||
Justso.data[10] := -32767;
|
||||
Justso.data[11] := -32767;
|
||||
Justso.data[12] := -24591;
|
||||
Justso.data[13] := -32767;
|
||||
Justso.data[14] := -32767;
|
||||
Justso.data[15] := -1;
|
||||
Justso.hotspot.v := 8;
|
||||
Justso.hotspot.h := 8;
|
||||
|
||||
{ Initialize the three rectangles. }
|
||||
|
||||
Initialize_Rectangles(Rectangle);
|
||||
|
||||
for J := 1 to 3 do
|
||||
Area[J] := NewRgn;
|
||||
|
||||
Open_Window(Window);
|
||||
|
||||
PenSize(2, 2);
|
||||
|
||||
{ Establish each of the three regions. }
|
||||
|
||||
begin { first region }
|
||||
OpenRgn;
|
||||
FrameRect(Rectangle[1]);
|
||||
CloseRgn(Area[1]);
|
||||
FillRgn(Area[1], white);
|
||||
end;
|
||||
begin { second region }
|
||||
OpenRgn;
|
||||
FrameRoundRect(Rectangle[2], 90, 90);
|
||||
CloseRgn(Area[2]);
|
||||
FrameRgn(Area[2]);
|
||||
MoveTo(100, 200);
|
||||
DrawString('Happy Region');
|
||||
end;
|
||||
begin { third region }
|
||||
OpenRgn;
|
||||
FrameOval(Rectangle[3]);
|
||||
CloseRgn(Area[3]);
|
||||
FrameRgn(Area[3]);
|
||||
MoveTo(360, 280);
|
||||
DrawString('Sad Region');
|
||||
end;
|
||||
|
||||
{ Prompt the user to continue. }
|
||||
MoveTo(266, 50);
|
||||
Drawstring(' Press mouse button to stop: ');
|
||||
|
||||
{ Establish a new cursor, and then obscure the new cursor until }
|
||||
{ the mouse is moved. }
|
||||
SetCursor(Justso);
|
||||
ShowCursor;
|
||||
ObscureCursor;
|
||||
while not button do
|
||||
begin
|
||||
GetMouse(Mousepoint);
|
||||
if PtInRgn(Mousepoint, Area[2]) then
|
||||
SetCursor(Smile)
|
||||
else if PtinRgn(Mousepoint, Area[3]) then
|
||||
SetCursor(Frown)
|
||||
else
|
||||
SetCursor(Justso);
|
||||
end;
|
||||
|
||||
{ Erase the complete screen with a gray background. }
|
||||
BackPat(gray);
|
||||
EraseRgn(Area[1]);
|
||||
|
||||
{ Dispose of storage for the window and the areas. }
|
||||
Dispose_of_Window(Window);
|
||||
for J := 1 to 3 do
|
||||
DisposeRgn(Area[J]);
|
||||
|
||||
end.
|
96
examples/date-print.pas
Normal file
96
examples/date-print.pas
Normal file
@ -0,0 +1,96 @@
|
||||
program ExampleDate;
|
||||
|
||||
type
|
||||
Date = record
|
||||
Month: string[8];
|
||||
Dayname: string[9];
|
||||
Day: 1..31;
|
||||
Year: Integer;
|
||||
Time: longint
|
||||
end;
|
||||
|
||||
var
|
||||
Access_Date: Date;
|
||||
Temp_Date: DateTimeRec;
|
||||
|
||||
function Present_Month (Number: integer): string;
|
||||
begin
|
||||
case Number of
|
||||
1:
|
||||
Present_Month := 'Jan';
|
||||
2:
|
||||
Present_Month := 'Feb';
|
||||
3:
|
||||
Present_Month := 'Mar';
|
||||
4:
|
||||
Present_Month := 'Apr';
|
||||
5:
|
||||
Present_Month := 'May';
|
||||
6:
|
||||
Present_Month := 'Jun';
|
||||
7:
|
||||
Present_Month := 'Jul';
|
||||
8:
|
||||
Present_Month := 'Aug';
|
||||
9:
|
||||
Present_Month := 'Sep';
|
||||
10:
|
||||
Present_Month := 'Oct';
|
||||
11:
|
||||
Present_Month := 'Nov';
|
||||
12:
|
||||
Present_Month := 'Dec';
|
||||
end;
|
||||
end;
|
||||
|
||||
function Present_Dayname (Number: integer): string;
|
||||
begin
|
||||
case Number of
|
||||
1:
|
||||
Present_Dayname := 'Sun';
|
||||
2:
|
||||
Present_Dayname := 'Mon';
|
||||
3:
|
||||
Present_Dayname := 'Tue';
|
||||
4:
|
||||
Present_Dayname := 'Wed';
|
||||
5:
|
||||
Present_Dayname := 'Thu';
|
||||
6:
|
||||
Present_Dayname := 'Fri';
|
||||
7:
|
||||
Present_Dayname := 'Sat';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Convert_Date (var Out_Date: Date; In_Date: DateTimeRec);
|
||||
begin
|
||||
Out_Date.Month := Present_Month(In_Date.Month);
|
||||
Out_date.Dayname := Present_Dayname(In_Date.DayOfWeek);
|
||||
Out_date.Day := In_date.Day;
|
||||
Out_Date.Year := In_Date.Year;
|
||||
Out_Date.Time := In_Date.Hour * 10000 + In_Date.Minute * 100 + In_Date.Second;
|
||||
end;
|
||||
|
||||
procedure Report_Date_Time (In_Date: Date);
|
||||
var
|
||||
Hour, Minute, Second: Integer;
|
||||
begin
|
||||
{ date }
|
||||
Write(In_Date.dayname, ', ', In_Date.Month);
|
||||
Writeln(In_Date.Day : 3, ', ', In_Date.Year : 4);
|
||||
{ time }
|
||||
Hour := 12 + In_Date.Time div 10000;
|
||||
Minute := (In_Date.Time - Hour * 10000) div 100;
|
||||
Second := In_Date.Time - (Hour * 10000 + Minute * 100);
|
||||
Writeln(hour : 2, ':', Minute : 2, ':', Second : 2);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
showText;
|
||||
GetTime(Temp_Date);
|
||||
Convert_Date(Access_Date, Temp_Date);
|
||||
Report_Date_Time(Access_Date);
|
||||
|
||||
end.
|
13
examples/date.pas
Normal file
13
examples/date.pas
Normal file
@ -0,0 +1,13 @@
|
||||
program ExampleDate;
|
||||
|
||||
var
|
||||
date: DateTimeRec;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
GetTime(date);
|
||||
Writeln('The current date is:');
|
||||
Writeln(date.year : 4, '-', date.month : 2, '-', date.day : 2);
|
||||
|
||||
end.
|
49
examples/draw-mirror.pas
Normal file
49
examples/draw-mirror.pas
Normal file
@ -0,0 +1,49 @@
|
||||
program ExampleDraw;
|
||||
|
||||
const
|
||||
radius = 10;
|
||||
var
|
||||
cursor, prev: Point;
|
||||
isDown: Boolean;
|
||||
|
||||
procedure WhenDownChanged;
|
||||
begin
|
||||
MoveTo(prev.h, prev.v);
|
||||
LineTo(cursor.h, cursor.v);
|
||||
MoveTo(300 - prev.h, prev.v);
|
||||
LineTo(300 - cursor.h, cursor.v);
|
||||
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);
|
||||
MoveTo(cursor.h, cursor.v);
|
||||
LineTo(prev.h, prev.v);
|
||||
repeat {Tight loop until button up}
|
||||
WhenDown;
|
||||
until not Button;
|
||||
end;
|
||||
until cursor.h > 300;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
Writeln('Started');
|
||||
MainLoop;
|
||||
Writeln('stopped');
|
||||
|
||||
end.
|
45
examples/draw.pas
Normal file
45
examples/draw.pas
Normal file
@ -0,0 +1,45 @@
|
||||
program ExampleDraw;
|
||||
|
||||
var
|
||||
cursor, prev: Point;
|
||||
isDown: Boolean;
|
||||
|
||||
procedure WhenDownChanged;
|
||||
begin
|
||||
MoveTo(prev.h, prev.v);
|
||||
LineTo(cursor.h, cursor.v);
|
||||
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);
|
||||
MoveTo(cursor.h, cursor.v);
|
||||
LineTo(prev.h, prev.v);
|
||||
repeat {Tight loop until button up}
|
||||
WhenDown;
|
||||
until not Button;
|
||||
end;
|
||||
until cursor.h < 0;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
Writeln('Started');
|
||||
MainLoop;
|
||||
Writeln('stopped');
|
||||
|
||||
end.
|
32
examples/euler.pas
Normal file
32
examples/euler.pas
Normal file
@ -0,0 +1,32 @@
|
||||
program EulerSpiral;
|
||||
|
||||
const
|
||||
l = 4;
|
||||
a = 11;
|
||||
var
|
||||
wx, wy, wa: Real;
|
||||
i: Integer;
|
||||
procedure DrawAngle;
|
||||
var
|
||||
t: Real;
|
||||
begin
|
||||
MoveTo(round(wx), round(wy));
|
||||
t := wa * PI / 180;
|
||||
wx := wx + l * cos(t);
|
||||
wy := wy + l * sin(t);
|
||||
wa := wa + (i * a);
|
||||
LineTo(round(wx), round(wy));
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
wx := 100;
|
||||
wy := 300;
|
||||
i := 0;
|
||||
ShowDrawing;
|
||||
repeat
|
||||
DrawAngle;
|
||||
i := i + 1;
|
||||
until i > 20000;
|
||||
|
||||
end.
|
53
examples/events.pas
Normal file
53
examples/events.pas
Normal file
@ -0,0 +1,53 @@
|
||||
program ExampleEvents;
|
||||
{Program to demonstrate detection of button events }
|
||||
{and use of button for program control. }
|
||||
|
||||
var
|
||||
tic1, tic2: Longint;
|
||||
|
||||
begin
|
||||
|
||||
{Open Drawing Window and label screen.}
|
||||
ShowDrawing;
|
||||
MoveTo(20, 20);
|
||||
TextSize(18);
|
||||
WriteDraw('Button Event Test');
|
||||
MoveTo(35, 40);
|
||||
TextSize(12);
|
||||
|
||||
WriteDraw('Double-Click to QUIT');
|
||||
MoveTo(40, 70);
|
||||
WriteDraw('Now the Button is: ');
|
||||
|
||||
{Use XOR pattern to erase and rewrite output}
|
||||
TextMode(srcXor);
|
||||
MoveTo(80, 100);
|
||||
TextSize(24);
|
||||
TextFace([bold]);
|
||||
|
||||
repeat {Until we double-click}
|
||||
while button do {Button down message detector}
|
||||
begin
|
||||
WriteDraw('down');
|
||||
MoveTo(80, 100);
|
||||
repeat {Tight loop until button up}
|
||||
until not Button;
|
||||
WriteDraw('down'); {Erase "down" text}
|
||||
MoveTo(80, 100);
|
||||
tic1 := TickCount; {Sample system clock: }
|
||||
end; {1/60 sec ticks}
|
||||
|
||||
while not button do { Button up message detector}
|
||||
begin
|
||||
WriteDraw('up');
|
||||
MoveTo(80, 100);
|
||||
repeat {Tight loop until button down}
|
||||
until button;
|
||||
WriteDraw('up'); {Erase "up" text}
|
||||
MoveTo(80, 100);
|
||||
tic2 := TickCount; {Sample system clock}
|
||||
end;
|
||||
|
||||
until abs(tic2 - tic1) < 30; {Double click message detector}
|
||||
|
||||
end.
|
24
examples/file.bin.pas
Normal file
24
examples/file.bin.pas
Normal file
@ -0,0 +1,24 @@
|
||||
program ExampleFileBinary;
|
||||
|
||||
type
|
||||
Number_File = file of real;
|
||||
|
||||
var
|
||||
Data_Block: Number_File;
|
||||
Counter: integer;
|
||||
A: array[1..10] of real;
|
||||
|
||||
begin
|
||||
|
||||
for Counter := 1 to 10 do
|
||||
A[Counter] := random;
|
||||
|
||||
Open(Data_Block, 'data');
|
||||
Rewrite(Data_Block);
|
||||
|
||||
for Counter := 1 to 10 do
|
||||
Write(Data_Block, A[Counter]);
|
||||
|
||||
Close(Data_Block);
|
||||
|
||||
end.
|
28
examples/file.get.pas
Normal file
28
examples/file.get.pas
Normal file
@ -0,0 +1,28 @@
|
||||
program ExampleFileBinary;
|
||||
|
||||
var
|
||||
globalRef: Integer;
|
||||
|
||||
procedure GetFile;
|
||||
var
|
||||
where: point;
|
||||
prompt: Str255;
|
||||
origName: Str255;
|
||||
err: OSErr;
|
||||
theReply: SFReply;
|
||||
myEOF: longint;
|
||||
begin
|
||||
setpt(where, 0, 0);
|
||||
prompt := 'Get resource File from';
|
||||
origName := 'unknownFile';
|
||||
SFGetFile(where, prompt, nil, -1, nil, nil, theReply);
|
||||
err := FSOpen(theReply.fname, theReply.vRefNum, globalRef);
|
||||
err := GetEOF(globalRef, myEOF);
|
||||
err := FSClose(globalRef);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
GetFile;
|
||||
|
||||
end.
|
24
examples/file.read.pas
Normal file
24
examples/file.read.pas
Normal file
@ -0,0 +1,24 @@
|
||||
program ExampleFileRead;
|
||||
|
||||
procedure ReadFile;
|
||||
var
|
||||
i: Integer;
|
||||
data: string;
|
||||
infile: Text;
|
||||
begin
|
||||
i := 0;
|
||||
Open(infile, OldFileName('Open txt file?'));
|
||||
repeat
|
||||
i := i + 1;
|
||||
Readln(infile, data);
|
||||
Writeln(data);
|
||||
until eof(infile);
|
||||
Reset(infile);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
ReadFile;
|
||||
|
||||
end.
|
19
examples/file.write.pas
Normal file
19
examples/file.write.pas
Normal file
@ -0,0 +1,19 @@
|
||||
program ExampleFile;
|
||||
|
||||
const
|
||||
FILENAME = 'data.txt';
|
||||
|
||||
var
|
||||
outfile: Text;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
|
||||
ReWrite(outfile, FILENAME);
|
||||
Writeln(outfile, 'hello world');
|
||||
Writeln(outfile, 'foo bar');
|
||||
|
||||
Writeln('Writing ', FILENAME, ' complete.');
|
||||
|
||||
end.
|
35
examples/fontface.pas
Normal file
35
examples/fontface.pas
Normal file
@ -0,0 +1,35 @@
|
||||
program ExampleFontface;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
MoveTo(70, 40);
|
||||
DrawString('Text');
|
||||
|
||||
TextFace([bold]);
|
||||
MoveTo(70, 55);
|
||||
DraWString('Bold');
|
||||
|
||||
TextFace([Italic]);
|
||||
MoveTo(70, 70);
|
||||
Drawstring('Italic');
|
||||
|
||||
TextFace([underline]);
|
||||
MoveTo(70, 85);
|
||||
DrawString('Underline');
|
||||
|
||||
TextFace([outline]);
|
||||
MoveTo(70, 100);
|
||||
DrawString('Outline');
|
||||
|
||||
MoveTo(70, 100);
|
||||
TextFace([Shadow]);
|
||||
|
||||
MoveTo(70, 115);
|
||||
Drawstring('Shadow');
|
||||
|
||||
{restore to normal }
|
||||
TextFace([]);
|
||||
|
||||
end.
|
14
examples/forloop.pas
Normal file
14
examples/forloop.pas
Normal file
@ -0,0 +1,14 @@
|
||||
program ExampleLoop;
|
||||
|
||||
var
|
||||
a: Integer;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
for a := 10 to 20 do
|
||||
begin
|
||||
Writeln('value of a: ', a);
|
||||
end;
|
||||
|
||||
end.
|
51
examples/fractal.pas
Normal file
51
examples/fractal.pas
Normal file
@ -0,0 +1,51 @@
|
||||
program ExampleFractal;
|
||||
|
||||
{ Program to play the Chaos Game }
|
||||
|
||||
{ Algorithm: }
|
||||
{ 1. Pick a point in a triangle at random & plot it }
|
||||
{ 2. Pick a vertex of the triangle at random }
|
||||
{ 3. Move 1/2 way from present point to this vertex }
|
||||
{ 4. Plot point and loop from (2) until mouse pressed.}
|
||||
|
||||
var
|
||||
xp, yp, i: integer;
|
||||
x, y: array[1..3] of real;
|
||||
|
||||
function Rndint (n: integer): integer;
|
||||
{Function to return random integer on range 1 --> n}
|
||||
var
|
||||
rr: longint;
|
||||
r: real;
|
||||
begin
|
||||
|
||||
rr := random; {Intrinsic routine}
|
||||
r := (rr + 32767) / (32767 + 32768);
|
||||
Rndint := trunc(n * r) + 1;
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
{Set corners of triangle centered at (110,125),}
|
||||
{with sides 200 pixels long}
|
||||
x[1] := 110 - 100;
|
||||
y[1] := 125 + 57.73503;
|
||||
x[2] := 110;
|
||||
y[2] := 125 - 115.470;
|
||||
x[3] := 110 + 100;
|
||||
y[3] := y[1];
|
||||
{Pick first point at random in box containing triangle}
|
||||
xp := Rndint(200) + 10;
|
||||
yp := Rndint(173) + 10;
|
||||
DrawLine(xp, yp, xp, yp); {Plot point}
|
||||
|
||||
repeat {until Mouse button is pressed}
|
||||
i := Rndint(3); {Pick random corner}
|
||||
xp := round((x[i] - xp) / 2 + xp); {Go half way}
|
||||
yp := round((y[i] - yp) / 2 + yp); {Go half way}
|
||||
DrawLine(xp, yp, xp, yp); {Plot point}
|
||||
until button;
|
||||
|
||||
end.
|
13
examples/function.pas
Normal file
13
examples/function.pas
Normal file
@ -0,0 +1,13 @@
|
||||
program ExampleFunction;
|
||||
|
||||
function Add (a, b: integer): Integer;
|
||||
begin
|
||||
Add := a + b;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
Writeln('5+6=', Add(5, 6));
|
||||
|
||||
end.
|
40
examples/gui0.pas
Normal file
40
examples/gui0.pas
Normal file
@ -0,0 +1,40 @@
|
||||
program ExampleGui0;
|
||||
|
||||
var
|
||||
w: WindowPtr; {A window to draw in}
|
||||
r: Rect; {The bounding box of the window}
|
||||
|
||||
{>>}
|
||||
procedure MainLoop;
|
||||
begin
|
||||
repeat
|
||||
until button;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
{Create the window}
|
||||
SetRect(r, 50, 50, 300, 100);
|
||||
w := NewWindow(nil, r, '', true, zoomDocProc, WindowPtr(-1), false, 0);
|
||||
|
||||
{Make it the current drawing port}
|
||||
SetPort(w);
|
||||
|
||||
{Draw a string!}
|
||||
MoveTo(20, 20);
|
||||
DrawString('Hello world!');
|
||||
|
||||
{Wait for a mouse-click, then stop.}
|
||||
MainLoop;
|
||||
|
||||
end.
|
||||
|
||||
{ window types }
|
||||
{ documentProc: movable, sizable window, no zoom box }
|
||||
{ dBoxProc: alert box or modal dialog box }
|
||||
{ plainDBox: plain box }
|
||||
{ altDBoxProc: plain box with shadow }
|
||||
{ noGrowDocProc: movable window, no size box or zoom box }
|
||||
{ movableDBoxProc: movable modal dialog box }
|
||||
{ zoomDocProc: standard document window }
|
||||
{ zoomNoGrow: zoomable, nonresizable window }
|
28
examples/gui1.pas
Normal file
28
examples/gui1.pas
Normal file
@ -0,0 +1,28 @@
|
||||
program ExampleGui1;
|
||||
|
||||
var
|
||||
w: WindowPtr; {A window to draw in}
|
||||
r: Rect; {The bounding box of the window}
|
||||
|
||||
procedure WindowInit;
|
||||
begin
|
||||
SetRect(r, 50, 50, 300, 100);
|
||||
w := NewWindow(nil, r, '', true, zoomDocProc, WindowPtr(-1), false, 0);
|
||||
SetPort(w);
|
||||
end;
|
||||
|
||||
procedure MainLoop;
|
||||
begin
|
||||
TextSize(24);
|
||||
MoveTo(20, 20);
|
||||
DrawString('Hello world!');
|
||||
repeat
|
||||
until button;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
WindowInit;
|
||||
MainLoop;
|
||||
|
||||
end.
|
59
examples/gui2.pas
Normal file
59
examples/gui2.pas
Normal file
@ -0,0 +1,59 @@
|
||||
program ExampleGui2;
|
||||
|
||||
const
|
||||
everyEvent = 8; { Exit on key}
|
||||
|
||||
var
|
||||
w: WindowPtr; {A window to draw in}
|
||||
r: Rect; {A window Size}
|
||||
gTheEvent: EventRecord;
|
||||
gDone: BOOLEAN;
|
||||
|
||||
procedure WindowInit;
|
||||
begin
|
||||
SetRect(r, 50, 50, 300, 100);
|
||||
w := NewWindow(nil, r, '', true, zoomDocProc, WindowPtr(-1), false, 0);
|
||||
SetPort(w);
|
||||
end;
|
||||
|
||||
procedure HandleEvent;
|
||||
var
|
||||
gotOne: BOOLEAN;
|
||||
begin
|
||||
SystemTask;
|
||||
gotOne := GetNextEvent(everyEvent, gTheEvent);
|
||||
if gotOne then
|
||||
begin
|
||||
gDone := TRUE;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MainLoop;
|
||||
begin
|
||||
gDone := FALSE;
|
||||
while gDone = FALSE do
|
||||
HandleEvent;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
WindowInit;
|
||||
MainLoop;
|
||||
|
||||
end.
|
||||
|
||||
{ mDownMask 2 }
|
||||
{ mUpMask 4 }
|
||||
{ keyDownMask 8 }
|
||||
{ keyUpMask 16 }
|
||||
{ autoKeyMask 32 }
|
||||
{ updateMask 64 }
|
||||
{ diskMask 128 }
|
||||
{ activMask 256 }
|
||||
{ networkMask 1024 }
|
||||
{ driverMask 2048 }
|
||||
{ app1 Mask4096 }
|
||||
{ app2Mask 8192 }
|
||||
{ app3Mask 16384 }
|
||||
{ app4Mask =32768 }
|
||||
{ everyEvent =1 }
|
88
examples/ifs.pas
Normal file
88
examples/ifs.pas
Normal file
@ -0,0 +1,88 @@
|
||||
program ExampleIFS;
|
||||
|
||||
const
|
||||
pixdim = 120;
|
||||
type
|
||||
pic = array[1..pixdim, 1..pixdim] of Boolean;
|
||||
vec = array[1..4] of Real;
|
||||
dimvec = array[1..4] of Integer;
|
||||
var
|
||||
s, t: pic;
|
||||
a, b, c, d, e, f, p: vec;
|
||||
x, y: dimvec;
|
||||
i, j, k, dpix: Integer;
|
||||
box: rect;
|
||||
|
||||
procedure pset (x, y: integer);
|
||||
begin
|
||||
Moveto(x, y);
|
||||
Lineto(x, y);
|
||||
end;
|
||||
|
||||
procedure DefineObject (var t: pic);
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
for i := 1 to pixdim do
|
||||
for j := 1 to pixdim do
|
||||
if j < i then
|
||||
begin
|
||||
t[i, j] := true;
|
||||
pset(i, j);
|
||||
end;
|
||||
SetRect(box, 1, 1, pixdim, pixdim);
|
||||
end;
|
||||
|
||||
procedure SetCoef (var a, b, c, d, e, f: vec);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 1 to 3 do
|
||||
begin
|
||||
a[i] := 0.5;
|
||||
b[i] := 0;
|
||||
c[i] := 0;
|
||||
d[i] := 0.5;
|
||||
e[i] := pixdim / 2;
|
||||
f[i] := 1;
|
||||
end;
|
||||
e[1] := 1;
|
||||
f[3] := pixdim / 2;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
DefineObject(t);
|
||||
SetCoef(a, b, c, d, e, f);
|
||||
dpix := pixdim div 2;
|
||||
|
||||
repeat
|
||||
for i := 1 to pixdim do
|
||||
for j := 1 to pixdim do
|
||||
if t[i, j] then
|
||||
begin
|
||||
for k := 1 to 3 do
|
||||
begin
|
||||
x[k] := trunc(a[k] * i + b[k] * j + e[k]);
|
||||
y[k] := trunc(c[k] * i + d[k] * j + f[k]);
|
||||
s[x[k], y[k]] := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
EraseRect(box);
|
||||
|
||||
for i := 1 to pixdim do
|
||||
for j := 1 to pixdim do
|
||||
begin
|
||||
t[i, j] := s[i, j];
|
||||
s[i, j] := false;
|
||||
if t[i, j] then
|
||||
pset(i, j);
|
||||
end;
|
||||
dpix := dpix div 2;
|
||||
WriteLn('dpix = ', dpix);
|
||||
until button or (dpix < 1)
|
||||
|
||||
end.
|
63
examples/julia.pas
Normal file
63
examples/julia.pas
Normal file
@ -0,0 +1,63 @@
|
||||
program ExampleJulia;
|
||||
|
||||
{Program to compute and plot Julia set.}
|
||||
|
||||
const
|
||||
scale = 0.01;
|
||||
R = 10;
|
||||
type
|
||||
complex = record
|
||||
r: Real;
|
||||
i: real
|
||||
end;
|
||||
var
|
||||
i, j, k, n, row, col, Nit: Integer;
|
||||
x, y: Real;
|
||||
z, znew, c: complex;
|
||||
done, gone: Boolean;
|
||||
procedure prod (a, b: complex; var c: complex);
|
||||
{Does complex multiplication: c = a bullet b}
|
||||
begin
|
||||
c.r := a.r * b.r - a.i * b.i;
|
||||
c.i := a.r * b.i + a.i * b.r;
|
||||
end;
|
||||
procedure add (a, b: complex; var c: complex);
|
||||
{Does complex addition: c = a + b}
|
||||
begin
|
||||
c.r := a.r + b.r;
|
||||
c.i := a.i + b.i;
|
||||
end;
|
||||
procedure plot (c, r: integer);
|
||||
{Procedure to pixel (c.r).}
|
||||
begin
|
||||
Moveto(c, r);
|
||||
Lineto(c, r);
|
||||
end;
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
writeLn('How many iterations at each point?');
|
||||
readLn(Nit);
|
||||
writeLn('Value of C: (Cr,Ci)?');
|
||||
ReadLn(c.r, c.i);
|
||||
showdrawing;
|
||||
ForeColor(blackColor);
|
||||
n := 0;
|
||||
for col := 1 to 400 do
|
||||
for row := 1 to 400 do
|
||||
begin
|
||||
z.r := (col - 200) * scale;
|
||||
z.i := (row - 200) * scale;
|
||||
repeat
|
||||
prod(z, z, znew);
|
||||
add(znew, c, z);
|
||||
gone := (z.r * z.r + z.i * z.i > R);
|
||||
n := n + 1;
|
||||
done := (n > Nit);
|
||||
until done or gone or button;
|
||||
if done then
|
||||
plot(col, row);
|
||||
n := 0;
|
||||
end;
|
||||
|
||||
end.
|
15
examples/keyboard.pas
Normal file
15
examples/keyboard.pas
Normal file
@ -0,0 +1,15 @@
|
||||
program ExampleKeyboard;
|
||||
|
||||
var
|
||||
Key: char;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
repeat
|
||||
Write('Press a key. ');
|
||||
Readln(Key);
|
||||
Writeln('The ordinal value of this key is ', ord(Key), '.');
|
||||
until ord(Key) = 22;
|
||||
|
||||
end.
|
33
examples/line.pas
Normal file
33
examples/line.pas
Normal file
@ -0,0 +1,33 @@
|
||||
program ExampleLines;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
MoveTo(100, 70);
|
||||
WriteDraw('A');
|
||||
MoveTo(140, 110);
|
||||
WriteDraw('B');
|
||||
MoveTo(125, 140);
|
||||
WriteDraw('C');
|
||||
MoveTo(60, 140);
|
||||
WriteDraw('D');
|
||||
|
||||
MoveTo(90, 110);
|
||||
WriteDraw('E');
|
||||
{Draw a line from point A to point B.}
|
||||
DrawLine(100, 70, 140, 110);
|
||||
{Draw a line from point B to point C.}
|
||||
LineTo(125, 140);
|
||||
{Draw a line from point c to point D.}
|
||||
LineTo(65, 140);
|
||||
{Draw a line from point D to point E.}
|
||||
LineTo(90, 110);
|
||||
{Draw a line from point E to point B.}
|
||||
LineTo(140, 110);
|
||||
{Finish drawing the remaining lines.}
|
||||
DrawLine(100, 70, 125, 140);
|
||||
DrawLine(100, 70, 65, 140);
|
||||
DrawLine(100, 70, 90, 110);
|
||||
|
||||
end.
|
19
examples/logic.pas
Normal file
19
examples/logic.pas
Normal file
@ -0,0 +1,19 @@
|
||||
program ExampleLogic;
|
||||
|
||||
{Comment}
|
||||
|
||||
var
|
||||
name: String;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
name := 'alice';
|
||||
if (name = 'alice') then
|
||||
Writeln('The name is alice.')
|
||||
else if (name = 'bob') then
|
||||
Writeln('The name is bob.')
|
||||
else
|
||||
Writeln('The name is not alice nor bob.');
|
||||
|
||||
end.
|
26
examples/logo.pas
Normal file
26
examples/logo.pas
Normal file
@ -0,0 +1,26 @@
|
||||
program Rabbits;
|
||||
|
||||
procedure Draw (row, col, size, pad: integer);
|
||||
var
|
||||
bounds: Rect;
|
||||
begin
|
||||
SetRect(bounds, col * size + pad, row * size + pad, (col * size + pad) + 8, (row * size + pad) + 8);
|
||||
PaintOval(bounds);
|
||||
end;
|
||||
|
||||
var
|
||||
row, col: Integer;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
repeat
|
||||
col := 0;
|
||||
repeat
|
||||
Draw(row, col, 10, 60);
|
||||
col := col + 1;
|
||||
until col = 10;
|
||||
row := row + 1;
|
||||
until row = 10;
|
||||
|
||||
end.
|
99
examples/mandelbrot.pas
Normal file
99
examples/mandelbrot.pas
Normal file
@ -0,0 +1,99 @@
|
||||
program ExampleMandelbrot;
|
||||
|
||||
const
|
||||
Nit = 100;
|
||||
scale = 0.005;
|
||||
R = 10;
|
||||
|
||||
type
|
||||
complex = record
|
||||
r: Real;
|
||||
i: real
|
||||
end;
|
||||
|
||||
var
|
||||
i, j, k, n, row, col: Integer;
|
||||
x, y: Real;
|
||||
z, znew, c: complex;
|
||||
done, gone: Boolean;
|
||||
render: Rect;
|
||||
|
||||
procedure prod (a, b: complex; var c: complex);
|
||||
|
||||
{Does complex multiplication: c = a bullet b}
|
||||
|
||||
begin
|
||||
c.r := a.r * b.r - a.i * b.i;
|
||||
c.i := a.r * b.i + a.i * b.r;
|
||||
|
||||
end;
|
||||
|
||||
procedure sub (a, b: complex; var c: complex);
|
||||
|
||||
{Does complex subtraction: c = a - b}
|
||||
|
||||
begin
|
||||
c.r := a.r - b.r;
|
||||
c.i := a.i - b.i;
|
||||
|
||||
end;
|
||||
|
||||
procedure plot (c, r, n: integer);
|
||||
|
||||
{Procedure to pixel (c.r) in color code n.}
|
||||
|
||||
begin
|
||||
|
||||
case n of
|
||||
0..4:
|
||||
ForeColor(blueColor);
|
||||
5:
|
||||
ForeColor(cyanColor);
|
||||
6:
|
||||
ForeColor(greenColor);
|
||||
7:
|
||||
ForeColor(magentaColor);
|
||||
8..11:
|
||||
ForeColor(redColor);
|
||||
12..20:
|
||||
ForeColor(yellowColor);
|
||||
21..99:
|
||||
ForeColor(whiteColor);
|
||||
100:
|
||||
ForeColor(blackColor);
|
||||
otherwise
|
||||
ForeColor(blackColor);
|
||||
end;
|
||||
Moveto(c, r);
|
||||
Lineto(c, r);
|
||||
r := 400 - r;
|
||||
Moveto(c, r);
|
||||
Lineto(c, r);
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
SetRect(render, 60, 60, 500, 440);
|
||||
SetDrawingRect(render);
|
||||
ShowDrawing;
|
||||
|
||||
for col := 1 to 400 do
|
||||
for row := 1 to 200 do
|
||||
begin
|
||||
z.r := 0.0;
|
||||
z.i := 0.0;
|
||||
c.r := (col - 100) * scale;
|
||||
c.i := (200 - row) * scale;
|
||||
repeat
|
||||
n := n + 1;
|
||||
prod(z, z, znew);
|
||||
sub(znew, c, z);
|
||||
done := (n > Nit);
|
||||
gone := (z.r * z.r + z.i * z.i > R);
|
||||
until done or gone or button;
|
||||
plot(col, row, n);
|
||||
n := 0;
|
||||
end;
|
||||
|
||||
end.
|
35
examples/mouse.pas
Normal file
35
examples/mouse.pas
Normal file
@ -0,0 +1,35 @@
|
||||
program ExampleMouse;
|
||||
|
||||
var
|
||||
Pt: Point;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
ShowText;
|
||||
|
||||
repeat {Until we double-click}
|
||||
|
||||
GetMouse(Pt);
|
||||
|
||||
{Button down message detector}
|
||||
|
||||
while button do
|
||||
begin
|
||||
Writeln('down', Pt.h, Pt.v);
|
||||
repeat {Tight loop until button up}
|
||||
until not Button;
|
||||
end;
|
||||
|
||||
{ Button up message detector}
|
||||
|
||||
while not button do
|
||||
begin
|
||||
Writeln('up', Pt.h, Pt.v);
|
||||
repeat {Tight loop until button down}
|
||||
until button;
|
||||
end;
|
||||
|
||||
until 1 > 1; { forever}
|
||||
|
||||
end.
|
26
examples/patterns.pas
Normal file
26
examples/patterns.pas
Normal file
@ -0,0 +1,26 @@
|
||||
program ExamplePatterns;
|
||||
|
||||
var
|
||||
rblack, rdkgray, rgray, rltgray, rwhite: Rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
SetRect(rblack, 10 + (50 * 0), 10, 10 + (50 * 1), 50);
|
||||
SetRect(rdkgray, 10 + (50 * 1), 10, 10 + (50 * 2), 50);
|
||||
SetRect(rgray, 10 + (50 * 2), 10, 10 + (50 * 3), 50);
|
||||
SetRect(rltgray, 10 + (50 * 3), 10, 10 + (50 * 4), 50);
|
||||
SetRect(rwhite, 10 + (50 * 4), 10, 10 + (50 * 5), 50);
|
||||
|
||||
FillRect(rblack, black);
|
||||
FillRect(rdkgray, dkgray);
|
||||
FillRect(rgray, gray);
|
||||
FillRect(rltgray, ltgray);
|
||||
FillRect(rwhite, white);
|
||||
FrameRect(rblack);
|
||||
FrameRect(rdkgray);
|
||||
FrameRect(rgray);
|
||||
FrameRect(rltgray);
|
||||
FrameRect(rwhite);
|
||||
|
||||
end.
|
25
examples/pen.pas
Normal file
25
examples/pen.pas
Normal file
@ -0,0 +1,25 @@
|
||||
program ExamplePen;
|
||||
|
||||
var
|
||||
x, y: Integer;
|
||||
Pt: Point;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
PenSize(10, 1);
|
||||
|
||||
while true do
|
||||
begin
|
||||
repeat
|
||||
until Button;
|
||||
GetMouse(Pt);
|
||||
MoveTo(Pt.h, Pt.v);
|
||||
while Button do
|
||||
begin
|
||||
GetMouse(Pt);
|
||||
LineTo(Pt.h, Pt.v);
|
||||
end
|
||||
end
|
||||
|
||||
end.
|
47
examples/picker.pas
Normal file
47
examples/picker.pas
Normal file
@ -0,0 +1,47 @@
|
||||
program ExamplePicker;
|
||||
|
||||
var
|
||||
Pt: Point;
|
||||
|
||||
procedure PaintPatterns;
|
||||
var
|
||||
selection: Rect;
|
||||
begin
|
||||
SetRect(selection, 10 + (50 * 0), 10, 10 + (50 * 1), 50);
|
||||
FillRect(selection, black);
|
||||
FrameRect(selection);
|
||||
SetRect(selection, 10 + (50 * 1), 10, 10 + (50 * 2), 50);
|
||||
FillRect(selection, dkgray);
|
||||
FrameRect(selection);
|
||||
SetRect(selection, 10 + (50 * 2), 10, 10 + (50 * 3), 50);
|
||||
FillRect(selection, gray);
|
||||
FrameRect(selection);
|
||||
SetRect(selection, 10 + (50 * 3), 10, 10 + (50 * 4), 50);
|
||||
FillRect(selection, ltgray);
|
||||
FrameRect(selection);
|
||||
SetRect(selection, 10 + (50 * 4), 10, 10 + (50 * 5), 50);
|
||||
FillRect(selection, white);
|
||||
FrameRect(selection);
|
||||
end;
|
||||
|
||||
procedure MainLoop;
|
||||
begin
|
||||
repeat {Until we double-click}
|
||||
GetMouse(Pt);
|
||||
while button do
|
||||
begin
|
||||
Writeln('pixel:', Pt.h : 4, ',', Pt.v : 4, '=', GetPixel(pt.h, pt.v));
|
||||
repeat {Tight loop until button up}
|
||||
until not Button;
|
||||
end;
|
||||
until 1 > 1; { forever}
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
ShowDrawing;
|
||||
PaintPatterns;
|
||||
MainLoop;
|
||||
|
||||
end.
|
85
examples/pict.dialog.pas
Normal file
85
examples/pict.dialog.pas
Normal file
@ -0,0 +1,85 @@
|
||||
program ExampleDrawingExport;
|
||||
|
||||
var
|
||||
pic: PicHandle;
|
||||
err: OSErr;
|
||||
outputRefNum: Integer;
|
||||
|
||||
procedure Cleanup;
|
||||
begin
|
||||
if outputRefNum <> -1 then
|
||||
begin
|
||||
err := FSClose(outputRefNum);
|
||||
outputRefNum := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckError;
|
||||
begin
|
||||
if err = noErr then
|
||||
Exit(CheckError);
|
||||
ShowText;
|
||||
WriteLn('Error:', err);
|
||||
Cleanup;
|
||||
Halt;
|
||||
end;
|
||||
|
||||
procedure PaintPicture;
|
||||
var
|
||||
clip, oval: rect;
|
||||
begin
|
||||
ShowDrawing;
|
||||
SetRect(clip, 0, 0, 100, 100);
|
||||
SetRect(oval, 20, 20, 80, 80);
|
||||
pic := OpenPicture(clip);
|
||||
FillOval(oval, ltgray);
|
||||
ClosePicture;
|
||||
DrawPicture(pic, clip);
|
||||
end;
|
||||
|
||||
procedure WriteFile;
|
||||
var
|
||||
toWrite, bigZero: Longint;
|
||||
i: integer;
|
||||
begin
|
||||
bigZero := 0;
|
||||
toWrite := SizeOf(Longint);
|
||||
for i := 1 to 512 div SizeOf(Longint) do
|
||||
err := FSWrite(outputRefNum, toWrite, @bigZero);
|
||||
CheckError;
|
||||
toWrite := GetHandleSize(Handle(pic));
|
||||
HLock(Handle(pic));
|
||||
err := FSWrite(outputRefNum, toWrite, Pointer(pic^));
|
||||
HUnlock(Handle(pic));
|
||||
CheckError;
|
||||
Cleanup;
|
||||
CheckError;
|
||||
KillPicture(pic);
|
||||
pic := nil;
|
||||
end;
|
||||
|
||||
procedure CreateFile;
|
||||
var
|
||||
wher: Point; { where to display dialog }
|
||||
reply: SFReply;
|
||||
begin
|
||||
wher.h := 20;
|
||||
wher.v := 20;
|
||||
SFPutFile(wher, 'Save the PICT as:', 'untitled.pict', nil, reply);
|
||||
if reply.good then
|
||||
begin
|
||||
err := Create(reply.fname, reply.vrefnum, '????', 'PICT');
|
||||
if (err = noerr) | (err = dupfnerr) then
|
||||
begin
|
||||
err := FSOpen(reply.fname, reply.vrefnum, outputRefNum);
|
||||
WriteFile;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
PaintPicture;
|
||||
CreateFile;
|
||||
|
||||
end.
|
69
examples/pict.export.pas
Normal file
69
examples/pict.export.pas
Normal file
@ -0,0 +1,69 @@
|
||||
program ExampleDrawingExport;
|
||||
|
||||
var
|
||||
oval, clip: Rect;
|
||||
pic: PicHandle;
|
||||
err: OSErr;
|
||||
refNum, i: Integer;
|
||||
toWrite, bigZero: Longint;
|
||||
|
||||
procedure Cleanup;
|
||||
begin
|
||||
if refNum <> -1 then
|
||||
begin
|
||||
err := FSClose(refNum);
|
||||
refNum := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckError;
|
||||
begin
|
||||
if err = noErr then
|
||||
Exit(CheckError);
|
||||
ShowText;
|
||||
WriteLn('Error:', err);
|
||||
Cleanup;
|
||||
Halt;
|
||||
end;
|
||||
|
||||
procedure PaintPicture;
|
||||
begin
|
||||
ShowDrawing;
|
||||
SetRect(oval, 20, 20, 80, 80);
|
||||
pic := OpenPicture(clip);
|
||||
FillOval(oval, black);
|
||||
ClosePicture;
|
||||
DrawPicture(pic, clip);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
refNum := -1;
|
||||
bigZero := 0;
|
||||
SetRect(clip, 0, 0, 100, 100);
|
||||
|
||||
PaintPicture;
|
||||
|
||||
err := Create('export', 0, 'RS$$', 'PICT');
|
||||
CheckError;
|
||||
err := FSOpen('export', 0, refNum);
|
||||
CheckError;
|
||||
|
||||
toWrite := SizeOf(Longint);
|
||||
for i := 1 to 512 div SizeOf(Longint) do
|
||||
err := FSWrite(refNum, toWrite, @bigZero);
|
||||
CheckError;
|
||||
toWrite := GetHandleSize(Handle(pic));
|
||||
HLock(Handle(pic));
|
||||
err := FSWrite(refNum, toWrite, Pointer(pic^));
|
||||
HUnlock(Handle(pic));
|
||||
|
||||
CheckError;
|
||||
Cleanup;
|
||||
CheckError;
|
||||
|
||||
KillPicture(pic);
|
||||
|
||||
pic := nil;
|
||||
|
||||
end.
|
67
examples/pict.open.pas
Normal file
67
examples/pict.open.pas
Normal file
@ -0,0 +1,67 @@
|
||||
program readPICT;
|
||||
{the following variable must be at the top level}
|
||||
|
||||
var
|
||||
globalRef: INTEGER; {refNum of the file to read from}
|
||||
err: OSErr;
|
||||
|
||||
{the following procedure must be at the top level}
|
||||
|
||||
procedure GetPICTData (dataPtr: Ptr; byteCount: INTEGER);
|
||||
var
|
||||
err: OSErr;
|
||||
longCount: LONGINT;
|
||||
begin
|
||||
longCount := byteCount;
|
||||
err := FSRead(globalRef, longCount, dataPtr);
|
||||
{can't check for an error because we don't know how to handle it}
|
||||
end;
|
||||
|
||||
const
|
||||
abortPICT = 128; {error code if DrawPicture aborted}
|
||||
|
||||
procedure GetDrawPICTFile; {read in a PICT FILE selected by the user}
|
||||
var
|
||||
wher: Point; {where to display dialog}
|
||||
reply: SFReply; {reply record}
|
||||
myFileTypes: SFTypeList; {more Standard FILE goodies}
|
||||
numFileTypes: INTEGER;
|
||||
savedProcs: QDProcsPtr;
|
||||
myProcs: QDProcs; {use CQDProcs for a color window}
|
||||
myPicture: PicHandle; {we need a picture handle for DrawPicture}
|
||||
longCount: LONGINT;
|
||||
myEOF: LONGINT;
|
||||
myFilePos: longint;
|
||||
begin
|
||||
myFilePos := 0;
|
||||
wher.h := 20;
|
||||
wher.v := 20;
|
||||
numFileTypes := 1; {display PICT files}
|
||||
myFileTypes[0] := 'PICT';
|
||||
SFGetFile(wher, '', nil, numFileTypes, nil, nil, reply);
|
||||
if reply.good then
|
||||
begin
|
||||
SetStdProcs(myProcs); {use SetStdCProcs for a CGrafPort}
|
||||
myProcs.getPicProc := @GetPICTData;
|
||||
savedProcs := thePort^.grafProcs; {set the grafProcs to ours}
|
||||
thePort^.grafProcs := @myProcs;
|
||||
myPicture := PicHandle(NewHandle(SizeOf(myPicture)));
|
||||
err := FSOpen(reply.fname, reply.vRefNum, globalRef);
|
||||
err := GetEOF(globalRef, myEOF); {get EOF for later check}
|
||||
err := SetFPos(globalRef, fsFromStart, 512); {skip header}
|
||||
longCount := SizeOf(myPicture);
|
||||
err := FSRead(globalRef, longCount, Ptr(myPicture^));
|
||||
DrawPicture(myPicture, myPicture^^.picFrame); {draw the picture}
|
||||
err := GetFPos(globalRef, myFilePos); {get position for check}
|
||||
err := FSClose(globalRef);
|
||||
DisposHandle(Handle(myPicture));
|
||||
thePort^.grafProcs := savedProcs; {restore the procs}
|
||||
if myFilePos <> myEOF then
|
||||
err := abortPICT;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
|
||||
end.
|
49
examples/pict.resource.pas
Normal file
49
examples/pict.resource.pas
Normal file
@ -0,0 +1,49 @@
|
||||
program ExamplePict;
|
||||
|
||||
const
|
||||
BASE_RES_ID = 400;
|
||||
var
|
||||
gPictureWindow: WindowPtr;
|
||||
gPictureWindowRect: Rect;
|
||||
|
||||
procedure CenterPict (thePicture: PicHandle; var myRect: Rect);
|
||||
var
|
||||
windRect, pictureRect: Rect;
|
||||
begin
|
||||
windRect := myRect;
|
||||
pictureRect := thePicture^^.picFrame;
|
||||
myRect.top := (windRect.bottom - windRect.top - (pictureRect.bottom - pictureRect.top)) div 2 + windRect.top;
|
||||
myRect.bottom := myRect.top + (pictureRect.bottom - pictureRect.top);
|
||||
myRect.left := (windRect.right - windRect.left - (pictureRect.right - pictureRect.left)) div 2 + windRect.left;
|
||||
myRect.right := myRect.left + (pictureRect.right - pictureRect.left);
|
||||
end;
|
||||
|
||||
procedure DrawMyPicture (pictureWindow: WindowPtr);
|
||||
var
|
||||
myRect: Rect;
|
||||
thePicture: PicHandle;
|
||||
begin
|
||||
myRect := pictureWindow^.portRect;
|
||||
thePicture := GetPicture(BASE_RES_ID);
|
||||
CenterPict(thePicture, myRect);
|
||||
DrawPicture(thePicture, myRect);
|
||||
end;
|
||||
|
||||
procedure WindowInit;
|
||||
begin
|
||||
SetRect(gPictureWindowRect, 150, 50, 300, 360);
|
||||
gPictureWindow := NewWindow(nil, gPictureWindowRect, 'Show Picture', true, zoomDocProc, WindowPtr(-1), false, 0);
|
||||
SetPort(gPictureWindow);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
WindowInit;
|
||||
DrawMyPicture(gPictureWindow);
|
||||
while (not Button) do
|
||||
begin
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
{ note: You must create a PICT asset with 400 in ResEdit, and add the Resource to Run Options. }
|
88
examples/pict.spool.pas
Normal file
88
examples/pict.spool.pas
Normal file
@ -0,0 +1,88 @@
|
||||
program ExampleDrawingExport;
|
||||
|
||||
var
|
||||
oval, clipin, clipout: Rect;
|
||||
output: PicHandle;
|
||||
|
||||
var
|
||||
PICTcount: LONGINT;
|
||||
globalRef: INTEGER;
|
||||
newPICThand: PicHandle;
|
||||
|
||||
procedure PutPICTData (dataPtr: Ptr; byteCount: INTEGER);
|
||||
var
|
||||
longCount: LONGINT;
|
||||
err: INTEGER;
|
||||
begin
|
||||
longCount := byteCount;
|
||||
PICTCount := PICTCount + byteCount;
|
||||
err := FSWrite(globalRef, longCount, dataPtr);
|
||||
if newPICTHand <> nil then
|
||||
newPICTHand^^.picSize := PICTCount;
|
||||
end;
|
||||
|
||||
procedure SpoolOutPICTFile (PICTHand: PicHandle );
|
||||
var
|
||||
err: OSErr;
|
||||
i: INTEGER;
|
||||
wher: Point; { where to display dialog }
|
||||
reply: SFReply;
|
||||
longCount, Zero: LONGINT;
|
||||
pframe: Rect;
|
||||
myProcs: QDProcs;
|
||||
begin
|
||||
wher.h := 20;
|
||||
wher.v := 20;
|
||||
SFPutFile(wher, 'Save the PICT as:', 'untitled', nil, reply);
|
||||
if reply.good then
|
||||
begin
|
||||
err := Create(reply.fname, reply.vrefnum, '????', 'PICT');
|
||||
if (err = noerr) | (err = dupfnerr) then
|
||||
begin
|
||||
err := FSOpen(reply.fname, reply.vrefnum, globalRef);
|
||||
SetStdProcs(myProcs); {use SetStdCProcs for a CGrafPort}
|
||||
thePort^.grafProcs := @myProcs;
|
||||
myProcs.putPicProc := @putPICTdata;
|
||||
Zero := 0;
|
||||
longCount := 2;
|
||||
PICTCount := SizeOf(Picture);
|
||||
{now write out the 512 byte header}
|
||||
for i := 1 to (512 + SizeOf(Picture)) div longCount do
|
||||
err := FSWrite(globalRef, longCount, @Zero);
|
||||
pFrame := PICThand^^.picFrame;
|
||||
newPICTHand := nil;
|
||||
newPICTHand := OpenPicture(pFrame);
|
||||
DrawPicture(PICTHand, pFrame);
|
||||
ClosePicture;
|
||||
err := SetFPos(globalRef, fsFromStart, 512);
|
||||
{skip the MacDraw header}
|
||||
longCount := SizeOf(Picture);
|
||||
{write out the correct (low word of the) size and the frame at the beginning}
|
||||
err := FSWrite(globalRef, longCount, Ptr(newPICTHand^));
|
||||
err := FSClose(globalRef);
|
||||
thePort^.grafProcs := nil;
|
||||
KillPicture(newPICTHand);
|
||||
end
|
||||
else
|
||||
err := err;
|
||||
end; {IF reply.good}
|
||||
end; {OutPICT}
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
SetRect(clipin, 0, 0, 100, 100);
|
||||
SetRect(clipout, 0, 0, 100, 100);
|
||||
SetRect(oval, 20, 20, 180, 180);
|
||||
|
||||
output := OpenPicture(clipin);
|
||||
PenPat(black);
|
||||
PaintOval(oval);
|
||||
ClosePicture;
|
||||
|
||||
DrawPicture(output, clipout);
|
||||
|
||||
SpoolOutPICTFile(output);
|
||||
|
||||
end.
|
42
examples/polygon.pas
Normal file
42
examples/polygon.pas
Normal file
@ -0,0 +1,42 @@
|
||||
program ExamplePolygon;
|
||||
|
||||
var
|
||||
myPoly: PolyHandle;
|
||||
myPattern: Pattern;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
myPoly := OpenPoly;
|
||||
MoveTo(30, 90);
|
||||
LineTo(30, 80);
|
||||
LineTo(50, 65);
|
||||
LineTo(90, 65);
|
||||
LineTo(80, 80);
|
||||
LineTo(95, 90);
|
||||
LineTo(30, 90);
|
||||
ClosePoly;
|
||||
|
||||
FramePoly(myPoly);
|
||||
|
||||
OffsetPoly(myPoly, 25, 15);
|
||||
PenSize(3, 2);
|
||||
ErasePoly(myPoly);
|
||||
FramePoly(myPoly);
|
||||
|
||||
OffsetPoly(myPoly, 25, 15);
|
||||
PaintPoly(myPoly);
|
||||
|
||||
OffsetPoly(myPoly, 25, 15);
|
||||
PaintPoly(myPoly);
|
||||
PenNormal;
|
||||
FillPoly(myPoly, gray);
|
||||
|
||||
OffsetPoly(myPoly, 25, 15);
|
||||
FillPoly(myPoly, myPattern);
|
||||
FramePoly(myPoly);
|
||||
|
||||
KillPoly(myPoly);
|
||||
|
||||
end.
|
41
examples/primitives.pas
Normal file
41
examples/primitives.pas
Normal file
@ -0,0 +1,41 @@
|
||||
program ExamplePrimitives;
|
||||
|
||||
{Program to demonstrate Pascal point & line primitives.}
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing; {Opens Drawing Window}
|
||||
|
||||
{First draw three points by three different functions}
|
||||
|
||||
PenSize(1, 1); {Sets pen size to 1 x 1 pixels}
|
||||
DrawLine(50, 50, 50, 50);
|
||||
WriteDraw(' Point at (50,50) using DrawLine');
|
||||
|
||||
PenSize(2, 2);
|
||||
MoveTo(100, 75); {Absolute move}
|
||||
LineTo(100, 75);
|
||||
WriteDraw(' Point at (100,75) using LineTo');
|
||||
|
||||
PenSize(3, 3);
|
||||
MoveTo(150, 100); {Absolute move}
|
||||
Line(0, 0);
|
||||
WriteDraw(' Point at (150,100) using Line');
|
||||
|
||||
{Now Draw three lines by three different functions}
|
||||
|
||||
MoveTo(150, 175); {Absolute move}
|
||||
WriteDraw('Line drawn with DrawLine');
|
||||
DrawLine(150, 125, 50, 225);
|
||||
|
||||
PenSize(2, 2);
|
||||
Move(0, 25); {Relative move}
|
||||
LineTo(150, 250);
|
||||
WriteDraw('Line drawn by LineTo');
|
||||
|
||||
Pensize(1, 1);
|
||||
Move(0, 25); {Relative move}
|
||||
Line(-100, 50);
|
||||
WriteDraw('Line drawn by Line');
|
||||
|
||||
end.
|
18
examples/procedure.pas
Normal file
18
examples/procedure.pas
Normal file
@ -0,0 +1,18 @@
|
||||
program ExampleProcedure;
|
||||
|
||||
procedure Tri (x, y, side: integer);
|
||||
begin
|
||||
MoveTo(x, y);
|
||||
LineTo(x + side, y);
|
||||
LineTo(x + side div 2, Round(y + Side / Sqrt(2)));
|
||||
LineTo(x, y);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
Tri(10, 10, 100);
|
||||
Tri(40, 40, 80);
|
||||
Tri(80, 85, 180);
|
||||
|
||||
end.
|
22
examples/random.pas
Normal file
22
examples/random.pas
Normal file
@ -0,0 +1,22 @@
|
||||
program ExampleRandom;
|
||||
|
||||
var
|
||||
x, ps, start1, start2, endpt1, endpt2: Integer;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
for x := 1 to 20 do
|
||||
begin
|
||||
ps := Random mod 10;
|
||||
start1 := Random mod 200;
|
||||
start2 := Random mod 200;
|
||||
endpt1 := Random mod 200;
|
||||
endpt2 := Random mod 200;
|
||||
PenSize(ps, ps);
|
||||
Moveto(start1 + 200, start2 + 100);
|
||||
Lineto(endpt1 + 200, endpt2 + 100);
|
||||
end
|
||||
|
||||
end.
|
23
examples/recurse.pas
Normal file
23
examples/recurse.pas
Normal file
@ -0,0 +1,23 @@
|
||||
program ExampleRecurse;
|
||||
|
||||
var
|
||||
i, left, top, right, bottom: Integer;
|
||||
box: rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
PenSize(9, 9);
|
||||
PenMode(patXor);
|
||||
|
||||
for i := 1 to 50 do
|
||||
begin
|
||||
left := 110 - 1 * i;
|
||||
top := 110 - 10 * i;
|
||||
right := 120 + 10 * i;
|
||||
bottom := 115 + 10 * i;
|
||||
SetRect(box, left, top, right, bottom);
|
||||
PaintOval(box);
|
||||
end
|
||||
|
||||
end.
|
24
examples/rings.pas
Normal file
24
examples/rings.pas
Normal file
@ -0,0 +1,24 @@
|
||||
program ExampleRings;
|
||||
|
||||
var
|
||||
Top, Left, Bottom, Right: Integer;
|
||||
Diam, Increase: Integer;
|
||||
Box: Rect;
|
||||
|
||||
begin
|
||||
|
||||
Top := 0;
|
||||
Left := 0;
|
||||
Diam := 0;
|
||||
Write('Type an integer between 1 and 25: ');
|
||||
Read(Increase);
|
||||
ShowDrawing;
|
||||
repeat
|
||||
Diam := Diam + Increase;
|
||||
Bottom := Diam;
|
||||
Right := Diam;
|
||||
SetRect(box, Left, Top, Right, Bottom);
|
||||
FrameOval(box);
|
||||
until Diam > 400
|
||||
|
||||
end.
|
42
examples/rubberband.pas
Normal file
42
examples/rubberband.pas
Normal file
@ -0,0 +1,42 @@
|
||||
program ExampleRubberBand;
|
||||
|
||||
var
|
||||
x1, y1, x2, y2: Integer;
|
||||
p: point;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing; {Open Drawing Window}
|
||||
MoveTo(20, 20); {Label graph and options}
|
||||
TextSize(18);
|
||||
WriteDraw('Rubber Band Program');
|
||||
TextSize(10);
|
||||
MoveTo(30, 40);
|
||||
WriteDraw('* Button down to draw line');
|
||||
MoveTo(30, 50);
|
||||
WriteDraw('* Double-click left of window to QUIT');
|
||||
PenMode(patXor); {Set Pen Mode to Xor}
|
||||
{to erase and redraw line}
|
||||
repeat {Keep working until exit}
|
||||
if Button then {executes once/line}
|
||||
begin
|
||||
GetMouse(p); {Read first point on line}
|
||||
x1 := p.h; {horizontal element of point}
|
||||
y1 := p.v;
|
||||
{ vertical element of point }
|
||||
while Button do {Loop until button released}
|
||||
begin
|
||||
GetMouse(p); {Read second point}
|
||||
x2 := p.h; {horizontal element}
|
||||
y2 := p.v;
|
||||
{ vertical element }
|
||||
DrawLine(x1, y1, x2, y2); {Draw line}
|
||||
DrawLine(x1, y1, x2, y2); {Erase line}
|
||||
end; {Now redraw permanent line }
|
||||
|
||||
DrawLine(x1, y1, x2, y2);
|
||||
end;
|
||||
|
||||
until (x1 < 0) and Button {Exit by clicking left}
|
||||
|
||||
end.
|
131
examples/saver.pas
Normal file
131
examples/saver.pas
Normal file
@ -0,0 +1,131 @@
|
||||
program ExampleSaver;
|
||||
|
||||
type
|
||||
Collider = object
|
||||
x, y, dx, dy, speed: Real;
|
||||
end;
|
||||
Size = object
|
||||
w, h: Integer;
|
||||
end;
|
||||
|
||||
var
|
||||
bounds: Size;
|
||||
frame, delay: Integer;
|
||||
view: Rect;
|
||||
p1, p2, p3: Collider;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
new(bounds);
|
||||
bounds.w := 420;
|
||||
bounds.h := 320;
|
||||
SetRect(view, 100, 100, bounds.w + 120, bounds.h + 120);
|
||||
setDrawingRect(view);
|
||||
PenSize(1, 1);
|
||||
ShowDrawing;
|
||||
frame := 0;
|
||||
new(p1);
|
||||
p1.x := Random mod bounds.w + 220;
|
||||
p1.y := Random mod bounds.h + 120;
|
||||
p1.speed := 3.5;
|
||||
p1.dx := p1.speed;
|
||||
p1.dy := p1.speed;
|
||||
new(p2);
|
||||
p2.x := Random mod bounds.w + 220;
|
||||
p2.y := Random mod bounds.h + 120;
|
||||
p2.speed := 6.5;
|
||||
p2.dx := -p2.speed;
|
||||
p2.dy := p2.speed;
|
||||
new(p3);
|
||||
p3.x := Random mod bounds.w + 220;
|
||||
p3.y := Random mod bounds.h + 120;
|
||||
p3.speed := 7.5;
|
||||
p3.dx := p3.speed;
|
||||
p3.dy := -p3.speed;
|
||||
end;
|
||||
|
||||
procedure Update;
|
||||
begin
|
||||
frame := frame + 1;
|
||||
{ p1 }
|
||||
if p1.x > bounds.w then
|
||||
begin
|
||||
p1.dx := -p1.speed;
|
||||
end;
|
||||
if p1.x < 0 then
|
||||
begin
|
||||
p1.dx := p1.speed;
|
||||
end;
|
||||
if p1.y > bounds.h then
|
||||
begin
|
||||
p1.dy := -p1.speed;
|
||||
end;
|
||||
if p1.y < 0 then
|
||||
begin
|
||||
p1.dy := p1.speed;
|
||||
end;
|
||||
|
||||
{ p2 }
|
||||
if p2.x > bounds.w then
|
||||
begin
|
||||
p2.dx := -p2.speed;
|
||||
end;
|
||||
if p2.x < 0 then
|
||||
begin
|
||||
p2.dx := p2.speed;
|
||||
end;
|
||||
if p2.y > bounds.h then
|
||||
begin
|
||||
p2.dy := -p2.speed;
|
||||
end;
|
||||
if p2.y < 0 then
|
||||
begin
|
||||
p2.dy := p2.speed;
|
||||
end;
|
||||
|
||||
{ p3 }
|
||||
if p3.x > bounds.w then
|
||||
begin
|
||||
p3.dx := -p3.speed;
|
||||
end;
|
||||
if p3.x < 0 then
|
||||
begin
|
||||
p3.dx := p3.speed;
|
||||
end;
|
||||
if p3.y > bounds.h then
|
||||
begin
|
||||
p3.dy := -p3.speed;
|
||||
end;
|
||||
if p3.y < 0 then
|
||||
begin
|
||||
p3.dy := p3.speed;
|
||||
end;
|
||||
|
||||
p1.x := p1.x + p1.dx;
|
||||
p1.y := p1.y + p1.dy;
|
||||
p2.x := p2.x + p2.dx;
|
||||
p2.y := p2.y + p2.dy;
|
||||
p3.x := p3.x + p3.dx;
|
||||
p3.y := p3.y + p3.dy;
|
||||
|
||||
end;
|
||||
|
||||
procedure Draw;
|
||||
begin
|
||||
MoveTo(round(p1.x), round(p1.y));
|
||||
LineTo(round(p2.x), round(p2.y));
|
||||
LineTo(round(p3.x), round(p3.y));
|
||||
LineTo(round(p1.x), round(p1.y));
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Init;
|
||||
|
||||
while frame < 200 do
|
||||
begin
|
||||
Update;
|
||||
Draw;
|
||||
end
|
||||
|
||||
end.
|
21
examples/scale.pas
Normal file
21
examples/scale.pas
Normal file
@ -0,0 +1,21 @@
|
||||
program ExampleScale;
|
||||
|
||||
var
|
||||
clip: Rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
{ origine }
|
||||
SetRect(clip, 10, 10, 100, 100);
|
||||
PaintArc(clip, 0, 180);
|
||||
FrameRect(clip);
|
||||
|
||||
{ scale }
|
||||
EraseArc(clip, 0, 180);
|
||||
InsetRect(clip, 20, 20);
|
||||
PaintArc(clip, 0, 180);
|
||||
FrameRect(clip);
|
||||
|
||||
end.
|
30
examples/shape.pas
Normal file
30
examples/shape.pas
Normal file
@ -0,0 +1,30 @@
|
||||
program ExampleShape;
|
||||
|
||||
const
|
||||
PI = 3.141592654;
|
||||
R = 60.0;
|
||||
DOTS = 10;
|
||||
|
||||
var
|
||||
dot: Integer;
|
||||
ax, ay, bx, by: Real;
|
||||
center: Point;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
dot := DOTS;
|
||||
setPt(center, 100, 100);
|
||||
|
||||
repeat
|
||||
ax := center.h + R * cos(2 * PI * dot / DOTS);
|
||||
ay := center.v + R * sin(2 * PI * dot / DOTS);
|
||||
bx := center.h + R * cos(2 * PI * (dot + 1) / DOTS);
|
||||
by := center.v + R * sin(2 * PI * (dot + 1) / DOTS);
|
||||
MoveTo(round(ax), round(ay));
|
||||
LineTo(round(bx), round(by));
|
||||
dot := dot - 1;
|
||||
until dot < 1;
|
||||
|
||||
end.
|
33
examples/shapes.pas
Normal file
33
examples/shapes.pas
Normal file
@ -0,0 +1,33 @@
|
||||
program ExampleShapes;
|
||||
|
||||
procedure TraceShape (cx, cy, r, sides: real);
|
||||
const
|
||||
PI = 3.141592654;
|
||||
var
|
||||
side: Real;
|
||||
ax, ay, bx, by: Real;
|
||||
center: Point;
|
||||
begin
|
||||
side := sides;
|
||||
setPt(center, 100, 100);
|
||||
repeat
|
||||
ax := center.h + r * cos(2 * PI * side / sides);
|
||||
ay := center.v + r * sin(2 * PI * side / sides);
|
||||
bx := center.h + r * cos(2 * PI * (side + 1) / sides);
|
||||
by := center.v + r * sin(2 * PI * (side + 1) / sides);
|
||||
MoveTo(round(ax), round(ay));
|
||||
LineTo(round(bx), round(by));
|
||||
side := side - 1;
|
||||
until side < 1;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
TraceShape(100, 100, 60, 24);
|
||||
TraceShape(100, 100, 60, 12);
|
||||
TraceShape(100, 100, 60, 6);
|
||||
TraceShape(100, 100, 60, 3);
|
||||
|
||||
end.
|
25
examples/sine.pas
Normal file
25
examples/sine.pas
Normal file
@ -0,0 +1,25 @@
|
||||
program ExampleSine;
|
||||
|
||||
const
|
||||
PI = 3.141592654;
|
||||
AMP = 50;
|
||||
var
|
||||
x, y: Real;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
x := 0;
|
||||
|
||||
repeat
|
||||
y := sin((x / 300) * (2 * PI)) * AMP;
|
||||
MoveTo(round(x), AMP + round(y));
|
||||
LineTo(round(x), AMP + round(y));
|
||||
x := x + 1;
|
||||
until x > 400
|
||||
|
||||
end.
|
||||
|
||||
{ note: If this does not draw a sine in THINK Pascal on Mac II }
|
||||
{ note: Project > Compile options : toggle 68881/ 68882 }
|
34
examples/sinefix.pas
Normal file
34
examples/sinefix.pas
Normal file
@ -0,0 +1,34 @@
|
||||
program SineFix;
|
||||
|
||||
uses
|
||||
FixMath;
|
||||
|
||||
var
|
||||
amp, y: Fixed;
|
||||
x, a: Longint;
|
||||
r: Rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
amp := Long2Fix(50);
|
||||
a := 0;
|
||||
repeat
|
||||
x := -1;
|
||||
ShowDrawing;
|
||||
MoveTo(-1, -1);
|
||||
repeat
|
||||
y := FracSin((x + a) * 6000);
|
||||
y := FixMul(Frac2Fix(y), amp);
|
||||
LineTo(x, Fix2Long(y + amp));
|
||||
x := x + 3;
|
||||
until x > 250;
|
||||
a := a + 10;
|
||||
SetRect(r, 0, 0, 250, 50 * 2 + 1);
|
||||
FillRect(r, white);
|
||||
until False;
|
||||
|
||||
end.
|
||||
|
||||
{ note: This project requires the FixMath library. }
|
57
examples/spiral.pas
Normal file
57
examples/spiral.pas
Normal file
@ -0,0 +1,57 @@
|
||||
program ExampleSpiral;
|
||||
|
||||
{Program to build spiral pattern, using}
|
||||
{relative line routine in a recursive loop}
|
||||
|
||||
var
|
||||
sign: Integer;
|
||||
|
||||
procedure Spiral (x, y, sign: integer);
|
||||
|
||||
{Procedure to spiral into limbo}
|
||||
|
||||
var
|
||||
temp: Integer;
|
||||
|
||||
begin
|
||||
|
||||
sign := (-1) * sign;
|
||||
if (abs(x) < 10) and (abs(y) < 10) then
|
||||
halt {Done recurring - ground case}
|
||||
else {Spiral still sizable}
|
||||
begin
|
||||
|
||||
line(x, y); {Plot relative line}
|
||||
|
||||
{Reduce magnitude of relative move by 5 pixels}
|
||||
|
||||
if abs(x) > abs(y) then
|
||||
x := x - (x div abs(x) * 5)
|
||||
else
|
||||
y := y - (y div abs(y) * 5);
|
||||
|
||||
{Exchange x<--> y}
|
||||
|
||||
temp := x;
|
||||
x := y;
|
||||
y := temp;
|
||||
|
||||
{On even calls, change sign}
|
||||
|
||||
x := sign * x;
|
||||
y := sign * y;
|
||||
Spiral(x, y, sign); {Recur}
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
sign := 1;
|
||||
PenSize(9, 9);
|
||||
MoveTo(20, 20);
|
||||
Spiral(200, 0, -1);
|
||||
|
||||
end.
|
19
examples/string.pas
Normal file
19
examples/string.pas
Normal file
@ -0,0 +1,19 @@
|
||||
program ExampleString;
|
||||
|
||||
var
|
||||
foo: String;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
|
||||
foo := 'foo';
|
||||
Writeln(foo);
|
||||
|
||||
foo[1] := 'b';
|
||||
foo[2] := 'a';
|
||||
foo[3] := 'r';
|
||||
|
||||
Writeln(foo); { outputs: bar }
|
||||
|
||||
end.
|
25
examples/strings.pas
Normal file
25
examples/strings.pas
Normal file
@ -0,0 +1,25 @@
|
||||
program ExampleStrings;
|
||||
|
||||
var
|
||||
width, height: Integer;
|
||||
ws, hs, combined: str255;
|
||||
drawingRect: Rect;
|
||||
|
||||
begin
|
||||
|
||||
width := 220;
|
||||
height := 140;
|
||||
|
||||
NumToString(width, ws);
|
||||
NumToString(height, hs);
|
||||
|
||||
SetRect(drawingRect, 60, 60, 60 + width, 60 + height);
|
||||
|
||||
ShowDrawing;
|
||||
SetDrawingRect(drawingRect);
|
||||
MoveTo(20, 20);
|
||||
WriteDraw('Window Size');
|
||||
MoveTo(20, 40);
|
||||
WriteDraw(concat(ws, 'x', hs));
|
||||
|
||||
end.
|
19
examples/time.pas
Normal file
19
examples/time.pas
Normal file
@ -0,0 +1,19 @@
|
||||
program ExampleTime;
|
||||
|
||||
var
|
||||
date: DateTimeRec;
|
||||
seconds: Longint;
|
||||
|
||||
begin
|
||||
|
||||
ShowText;
|
||||
|
||||
GetTime(date);
|
||||
GetDateTime(seconds);
|
||||
Writeln('The current time is:');
|
||||
Writeln(date.hour : 2, ':', date.minute : 2, ':', date.second : 2);
|
||||
Writeln;
|
||||
Writeln('Seconds since midnight, January 1, 1904:');
|
||||
Writeln(-seconds);
|
||||
|
||||
end.
|
24
examples/towerofhanoi.pas
Normal file
24
examples/towerofhanoi.pas
Normal file
@ -0,0 +1,24 @@
|
||||
program TowersOfHanoi (input, output);
|
||||
|
||||
var
|
||||
disks: Integer;
|
||||
|
||||
procedure Hanoi (source, temp, destination: char; n: integer);
|
||||
|
||||
begin
|
||||
if n > 0 then
|
||||
begin
|
||||
Hanoi(source, destination, temp, n - 1);
|
||||
Writeln('Move disk ', n : 1, ' from peg ', source, ' to peg ', destination);
|
||||
Hanoi(temp, source, destination, n - 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Write('Enter the number of disks: ');
|
||||
Readln(disks);
|
||||
Writeln('Solution:');
|
||||
Hanoi('A', 'B', 'C', disks);
|
||||
|
||||
end.
|
21
examples/translate.pas
Normal file
21
examples/translate.pas
Normal file
@ -0,0 +1,21 @@
|
||||
program ExampleTranslate;
|
||||
|
||||
var
|
||||
clip: Rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
{ origine }
|
||||
SetRect(clip, 10, 10, 100, 100);
|
||||
PaintArc(clip, 0, 180);
|
||||
FrameRect(clip);
|
||||
|
||||
{ translation }
|
||||
EraseArc(clip, 0, 180);
|
||||
OffSetRect(clip, 40, 40);
|
||||
PaintArc(clip, 0, 180);
|
||||
FrameRect(clip);
|
||||
|
||||
end.
|
15
examples/wedge.pas
Normal file
15
examples/wedge.pas
Normal file
@ -0,0 +1,15 @@
|
||||
program ExampleWedge;
|
||||
|
||||
var
|
||||
whole, wedge: Rect;
|
||||
|
||||
begin
|
||||
|
||||
ShowDrawing;
|
||||
|
||||
SetRect(whole, 10, 10, 90, 90);
|
||||
PaintArc(whole, 0, 144);
|
||||
FillArc(whole, 144, 120, ltgray);
|
||||
FrameOval(whole);
|
||||
|
||||
end.
|
267
projects/EventTutor/EventTutor.pas
Normal file
267
projects/EventTutor/EventTutor.pas
Normal file
@ -0,0 +1,267 @@
|
||||
program EventTutor;
|
||||
|
||||
const
|
||||
BASE_RES_ID = 400;
|
||||
LEAVE_WHERE_IT_IS = FALSE;
|
||||
NORMAL_UPDATES = TRUE;
|
||||
SLEEP = 60;
|
||||
WNE_TRAP_NUM = $60;
|
||||
UNIMPL_TRAP_NUM = $9F;
|
||||
SUSPEND_RESUME_BIT = $0001;
|
||||
ACTIVATING = 1;
|
||||
RESUMING = 1;
|
||||
TEXT_FONT_SIZE = 12;
|
||||
DRAG_THRESHOLD = 30;
|
||||
MIN_WINDOW_HEIGHT = 50;
|
||||
MIN_WINDOW_WIDTH = 50;
|
||||
SCROLL_BAR_PIXELS = 15;
|
||||
ROWHEIGHT = 15;
|
||||
LEFTMARGIN = 10;
|
||||
STARTROW = 0;
|
||||
HORIZONTAL_OFFSET = 0;
|
||||
|
||||
var
|
||||
gPictWindow, gEventWindow: WindowPtr;
|
||||
gTheEvent: EventRecord;
|
||||
gSizeRect: Rect;
|
||||
gDone, gWNEimplemented: BOOLEAN;
|
||||
gCurRow, gMaxRow: INTEGER;
|
||||
|
||||
{>>}
|
||||
procedure CenterPict (thePicture: PicHandle; var myRect: Rect);
|
||||
var
|
||||
windRect, pictureRect: Rect;
|
||||
begin
|
||||
windRect := myRect;
|
||||
pictureRect := thePicture^^.picFrame;
|
||||
myRect.top := (windRect.bottom - windRect.top - (pictureRect.bottom - pictureRect.top)) div 2 + windRect.top;
|
||||
myRect.bottom := myRect.top + (pictureRect.bottom - pictureRect.top);
|
||||
myRect.left := (windRect.right - windRect.left - (pictureRect.right - pictureRect.left)) div 2 + windRect.left;
|
||||
myRect.right := myRect.left + (pictureRect.right - pictureRect.left);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure DrawMyPicture (drawingWindow: WindowPtr);
|
||||
var
|
||||
drawingClipRect, myRect: Rect;
|
||||
oldPort: GrafPtr;
|
||||
tempRgn: RgnHandle;
|
||||
thePicture: PicHandle;
|
||||
begin
|
||||
GetPort(oldPort);
|
||||
SetPort(drawingWindow);
|
||||
tempRgn := NewRgn;
|
||||
GetClip(tempRgn);
|
||||
EraseRect(drawingWindow^.portRect);
|
||||
DrawGrowicon(drawingWindow);
|
||||
drawingClipRect := drawingWindow^.portRect;
|
||||
drawingClipRect.right := drawingClipRect.right - SCROLL_BAR_PIXELS;
|
||||
drawingClipRect.bottom := drawingClipRect.bottom - SCROLL_BAR_PIXELS;
|
||||
myRect := drawingWindow^.portRect;
|
||||
thePicture := GetPicture(BASE_RES_ID);
|
||||
CenterPict(thePicture, myRect);
|
||||
ClipRect(drawingClipRect);
|
||||
DrawPicture(thePicture, myRect);
|
||||
SetClip(tempRgn);
|
||||
DisposeRgn(tempRgn);
|
||||
SetPort(oldPort);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleMouseDown;
|
||||
var
|
||||
whichWindow: WindowPtr;
|
||||
thePart: INTEGER;
|
||||
windSize: LONGINT;
|
||||
oldPort: GrafPtr;
|
||||
begin
|
||||
thePart := FindWindow(gTheEvent.where, whichWindow);
|
||||
case thePart of
|
||||
inSysWindow:
|
||||
SystemClick(gTheEvent, whichWindow);
|
||||
inDrag:
|
||||
DragWindow(whichWindow, gTheEvent.where, screenBits.bounds);
|
||||
inContent:
|
||||
if whichWindow <> FrontWindow then
|
||||
SelectWindow(whichWindow);
|
||||
inGrow:
|
||||
begin
|
||||
windSize := GrowWindow(whichWindow, gTheEvent.where, gSizeRect);
|
||||
if (windSize <> 0) then
|
||||
begin
|
||||
GetPort(oldPort);
|
||||
SetPort(whichWindow);
|
||||
EraseRect(whichWindow^.portRect);
|
||||
SizeWindow(whichWindow, LoWord(windSize), HiWord(windSize), NORMAL_UPDATES);
|
||||
InvalRect(whichWindow^.portRect);
|
||||
SetPort(oldPort);
|
||||
end;
|
||||
end;
|
||||
inGoAway:
|
||||
gDone := TRUE;
|
||||
inZoomIn, inZoomOut:
|
||||
if TrackBox(whichWindow, gTheEvent.where, thePart) then
|
||||
begin
|
||||
GetPort(oldPort);
|
||||
SetPort(whichWindow);
|
||||
EraseRect(whichWindow^.portRect);
|
||||
ZoomWindow(whichWindow, thePart, LEAVE_WHERE_IT_IS);
|
||||
InvalRect(whichWindow^.portRect);
|
||||
SetPort(oldPort);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure ScrollWindow;
|
||||
var
|
||||
tempRgn: RgnHandle;
|
||||
begin
|
||||
tempRgn := NewRgn;
|
||||
ScrollRect(gEventWindow^.portRect, HORIZONTAL_OFFSET, -ROWHEIGHT, tempRgn);
|
||||
DisposeRgn(tempRgn);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure DrawEventString (s: Str255);
|
||||
begin
|
||||
if (gCurRow > gMaxRow) then
|
||||
ScrollWindow
|
||||
else
|
||||
gCurRow := gCurRow + ROWHEIGHT;
|
||||
MoveTo(LEFTMARGIN, gCurRow);
|
||||
DrawString(s);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleEvent;
|
||||
var
|
||||
gotOne: BOOLEAN;
|
||||
begin
|
||||
if gWNEimplemented then
|
||||
gotOne := WaitNextEvent(everyEvent, gTheEvent, SLEEP, nil)
|
||||
else
|
||||
begin
|
||||
SystemTask;
|
||||
gotOne := GetNextEvent(everyEvent, gTheEvent);
|
||||
end;
|
||||
if gotOne then
|
||||
case gTheEvent.what of
|
||||
nullEvent:
|
||||
begin
|
||||
end;
|
||||
mouseDown:
|
||||
begin
|
||||
DrawEventString('mouseDown');
|
||||
HandleMouseDown;
|
||||
end;
|
||||
mouseUp:
|
||||
DrawEventString('mouseUp');
|
||||
keyDown:
|
||||
DrawEventString('keyDown');
|
||||
keyUp:
|
||||
DrawEventString('keyUp');
|
||||
autoKey:
|
||||
DrawEventString('autoKey');
|
||||
updateEvt:
|
||||
if (WindowPtr(gTheEvent.message) = gPictWindow) then
|
||||
begin
|
||||
DrawEventString('updateEvt: gPictWindow');
|
||||
BeginUpdate(WindowPtr(gTheEvent.message));
|
||||
DrawMyPicture(WindowPtr(gTheEvent.message));
|
||||
EndUpdate(WindowPtr(gTheEvent.message));
|
||||
end
|
||||
else
|
||||
begin
|
||||
DrawEventString('updateEvt:gEventWindow ');
|
||||
BeginUpdate(WindowPtr(gTheEvent.message));
|
||||
EndUpdate(WindowPtr(gTheEvent.message));
|
||||
end;
|
||||
diskEvt:
|
||||
DrawEventString('diskEvt');
|
||||
activateEvt:
|
||||
if (WindowPtr(gTheEvent.message) = gPictWindow) then
|
||||
begin
|
||||
DrawGrowicon(WindowPtr(gTheEvent.message));
|
||||
if (BitAnd(gTheEvent.modifiers, activeFlag) = ACTIVATING) then
|
||||
DrawEventString('activateEvt: activating gPictWindow')
|
||||
else
|
||||
DrawEventString('activateEvt: deactivating gPictWindow');
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (BitAnd(gTheEvent.modifiers, activeFlag) = ACTIVATING) then
|
||||
DrawEventString('activateEvt: activating gEventWindow')
|
||||
else
|
||||
DrawEventString('activateEvt: deactivating gEventWindow');
|
||||
end;
|
||||
networkEvt:
|
||||
DrawEventString('networkEvt');
|
||||
driverEvt:
|
||||
DrawEventString('driverEvt');
|
||||
app1Evt:
|
||||
DrawEventString('app1Evt');
|
||||
app2Evt:
|
||||
DrawEventString('app2Evt');
|
||||
app3Evt:
|
||||
DrawEventString('app3Evt');
|
||||
app4Evt:
|
||||
if (BitAnd(gTheEvent.message, SUSPEND_RESUME_BIT) = RESUMING) then
|
||||
DrawEventString('Resume event')
|
||||
else
|
||||
DrawEventString('Suspend event');
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure MainLoop;
|
||||
begin
|
||||
gDone := FALSE;
|
||||
gWNEimplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPL_TRAP_NUM, ToolTrap));
|
||||
while gDone = FALSE do
|
||||
HandleEvent;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure SetUpSizeRect;
|
||||
begin
|
||||
gSizeRect.top := MIN_WINDOW_HEIGHT;
|
||||
gSizeRect.left := MIN_WINDOW_WIDTH;
|
||||
gSizeRect.bottom := 32767;
|
||||
gSizeRect.right := 32767;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure SetupEventWindow;
|
||||
var
|
||||
eventRect: Rect;
|
||||
fontNum: INTEGER;
|
||||
begin
|
||||
eventRect := gEventWindow^.portRect;
|
||||
gMaxRow := eventRect.bottom - eventRect.top - ROWHEIGHT;
|
||||
gCurRow := STARTROW;
|
||||
SetPort(gEventWindow);
|
||||
GetFNum('monaco', fontNum);
|
||||
TextFont(fontNum);
|
||||
TextSize(TEXT_FONT_SIZE);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure Windowinit;
|
||||
begin
|
||||
gPictWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
|
||||
gEventWindow := GetNewWindow(BASE_RES_ID + 1, nil, WindowPtr(-1));
|
||||
SetupEventWindow;
|
||||
ShowWindow(gEventWindow);
|
||||
ShowWindow(gPictWindow);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Windowinit;
|
||||
SetUpSizeRect;
|
||||
Mainloop;
|
||||
|
||||
end.
|
||||
|
||||
{ note: This projects needs 2 WIND resources with id 400 and 401, and a PICT resource with id 400 }
|
203
projects/SimpleMenu/SimpleMenu.pas
Normal file
203
projects/SimpleMenu/SimpleMenu.pas
Normal file
@ -0,0 +1,203 @@
|
||||
program SimpleMenu;
|
||||
|
||||
const
|
||||
BASE_RES_ID = 400;
|
||||
INCLUDE_SECONDS = TRUE;
|
||||
SLEEP = 60;
|
||||
WNE_TRAP_NUM = $60;
|
||||
UNIMPL_TRAP_NUM = $9F;
|
||||
QUIT_ITEM = 1;
|
||||
ABOUT_ITEM = 1;
|
||||
APPLE_MENU_ID = BASE_RES_ID;
|
||||
FILE_MENU_ID = BASE_RES_ID + 1;
|
||||
EDIT_MENU_ID = BASE_RES_ID + 2;
|
||||
OPTIONS_MENU_ID = BASE_RES_ID + 3;
|
||||
ABOUT_ALERT = 400;
|
||||
|
||||
var
|
||||
gClockWindow: WindowPtr;
|
||||
gDone, gWNEimplemented: BOOLEAN;
|
||||
gCurrentTime, gOldTime: LONGINT;
|
||||
gTheEvent: EventRecord;
|
||||
|
||||
{>>}
|
||||
procedure HandleAppleChoice (theItem: INTEGER);
|
||||
var
|
||||
accName: Str255;
|
||||
accNumber, itemNumber, dummy: INTEGER;
|
||||
appleMenu: MenuHandle;
|
||||
begin
|
||||
case theItem of
|
||||
ABOUT_ITEM:
|
||||
dummy := NoteAlert(ABOUT_ALERT, nil);
|
||||
otherwise
|
||||
begin
|
||||
appleMenu := GetMHandle(APPLE_MENU_ID);
|
||||
GetItem(appleMenu, theItem, accName);
|
||||
accNumber := OpenDeskAcc(accName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleFileChoice (theItem: INTEGER);
|
||||
begin
|
||||
case theItem of
|
||||
QUIT_ITEM:
|
||||
gDone := TRUE;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleOptionsChoice (theItem: INTEGER);
|
||||
var
|
||||
fontNumber: INTEGER;
|
||||
fontName: Str255;
|
||||
fontMenu: MenuHandle;
|
||||
begin
|
||||
Writeln(theItem);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleMenuChoice (menuChoice: LONGINT);
|
||||
var
|
||||
theMenu, theItem: INTEGER;
|
||||
begin
|
||||
if menuChoice <> 0 then
|
||||
begin
|
||||
theMenu := HiWord(menuChoice);
|
||||
theItem := LoWord(menuChoice);
|
||||
case theMenu of
|
||||
APPLE_MENU_ID:
|
||||
HandleAppleChoice(theItem);
|
||||
FILE_MENU_ID:
|
||||
HandleFileChoice(theItem);
|
||||
OPTIONS_MENU_ID:
|
||||
HandleOptionsChoice(theItem);
|
||||
end;
|
||||
HiliteMenu(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleMouseDown;
|
||||
var
|
||||
whichWindow: WindowPtr;
|
||||
thePart: INTEGER;
|
||||
menuChoice, windSize: LONGINT;
|
||||
begin
|
||||
thePart := FindWindow(gTheEvent.where, whichWindow);
|
||||
case thePart of
|
||||
inMenuBar:
|
||||
begin
|
||||
menuChoice := MenuSelect(gTheEvent.where);
|
||||
HandleMenuChoice(menuChoice);
|
||||
end;
|
||||
inSysWindow:
|
||||
SystemClick(gTheEvent, whichWindow);
|
||||
inDrag:
|
||||
DragWindow(whichWindow, gTheEvent.where, screenBits.bounds);
|
||||
inGoAway:
|
||||
gDone := TRUE;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure DrawClock (theWindow: WindowPtr);
|
||||
var
|
||||
myTimeString: Str255;
|
||||
begin
|
||||
IUTimeString(gCurrentTime, INCLUDE_SECONDS, myTimeString);
|
||||
EraseRect(theWindow^.portRect);
|
||||
MoveTo(12, 25);
|
||||
DrawString(myTimeString);
|
||||
gOldTime := gCurrentTime;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleNull;
|
||||
begin
|
||||
GetDateTime(gCurrentTime);
|
||||
if gCurrentTime <> gOldTime then
|
||||
DrawClock(gClockWindow);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleEvent;
|
||||
var
|
||||
theChar: CHAR;
|
||||
dummy: BOOLEAN;
|
||||
begin
|
||||
if gWNEimplemented then
|
||||
dummy := WaitNextEvent(everyEvent, gTheEvent, SLEEP, nil)
|
||||
else
|
||||
begin
|
||||
SystemTask;
|
||||
dummy := GetNextEvent(everyEvent, gTheEvent);
|
||||
end;
|
||||
case gTheEvent.what of
|
||||
nullEvent:
|
||||
HandleNull;
|
||||
mouseDown:
|
||||
HandleMouseDown;
|
||||
keyDown, autoKey:
|
||||
begin
|
||||
theChar := CHR(BitAnd(gTheEvent.message, charCodeMask));
|
||||
if (BitAnd(gTheEvent.modifiers, cmdKey) <> 0) then
|
||||
HandleMenuChoice(MenuKey(theChar));
|
||||
end;
|
||||
updateEvt:
|
||||
begin
|
||||
BeginUpdate(WindowPtr(gTheEvent.message));
|
||||
EndUpdate(WindowPtr(gTheEvent.message));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure MainLoop;
|
||||
begin
|
||||
gDone := FALSE;
|
||||
gWNEimplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPL_TRAP_NUM, ToolTrap));
|
||||
while (gDone = FALSE) do
|
||||
HandleEvent;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure MenuBarInit;
|
||||
var
|
||||
myMenuBar: Handle;
|
||||
aMenu: MenuHandle;
|
||||
begin
|
||||
myMenuBar := GetNewMBar(BASE_RES_ID);
|
||||
SetMenuBar(myMenuBar);
|
||||
DisposHandle(myMenuBar);
|
||||
aMenu := GetMHandle(APPLE_MENU_ID);
|
||||
AddResMenu(aMenu, 'DRVR');
|
||||
DrawMenuBar;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure Windowinit;
|
||||
begin
|
||||
gClockWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
|
||||
SetPort(gClockWindow);
|
||||
ShowWindow(gClockWindow);
|
||||
TextSize(24);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Windowinit;
|
||||
MenuBarInit;
|
||||
DrawClock(gClockWindow);
|
||||
MainLoop;
|
||||
|
||||
end.
|
||||
|
||||
{ Resources needed: }
|
||||
{ 1x WIND #400 }
|
||||
{ 1x MBAR #400 4 options}
|
||||
{ 1x MENU #400 -> Apple#400[about] File#401[quit] Edit#402[undo, cut, copy, paste, clear] Options#403[option1, option2] }
|
||||
{ 1x ALRT #400 }
|
||||
{ 1x DITL #400 }
|
287
projects/Timer/Timer.pas
Normal file
287
projects/Timer/Timer.pas
Normal file
@ -0,0 +1,287 @@
|
||||
program Timer;
|
||||
|
||||
const
|
||||
BASE_RES_ID = 400;
|
||||
PLAIN = [];
|
||||
PLAIN_ITEM = 1;
|
||||
BOLD_ITEM = 2;
|
||||
ITALIC_ITEM = 3;
|
||||
UNDERLINE_ITEM = 4;
|
||||
OUTLINE_ITEM = 5;
|
||||
SHADOW_ITEM = 6;
|
||||
|
||||
INCLUDE_SECONDS = TRUE;
|
||||
|
||||
ADD_CHECK_MARK = TRUE;
|
||||
REMOVE_CHECK_MARK = FALSE;
|
||||
|
||||
DRAG_THRESHOLD = 30;
|
||||
|
||||
SLEEP = 60;
|
||||
WNE_TRAP_NUM = $60;
|
||||
UNIMPL_TRAP_NUM = $9F;
|
||||
|
||||
QUIT_ITEM = 1;
|
||||
ABOUT_ITEM = 1;
|
||||
|
||||
NOT_A_NORMAL_MENU = -1;
|
||||
APPLE_MENU_ID = BASE_RES_ID;
|
||||
FILE_MENU_ID = BASE_RES_ID + 1;
|
||||
FONT_MENU_ID = 100;
|
||||
STYLE_MENU_ID = 101;
|
||||
|
||||
CLOCK_LEFT = 12;
|
||||
CLOCK_TOP = 25;
|
||||
CLOCK_SIZE = 24;
|
||||
|
||||
ABOUT_ALERT = 400;
|
||||
|
||||
var
|
||||
gClockWindow: WindowPtr;
|
||||
gDone, gWNEimplemented: BOOLEAN;
|
||||
gCurrentTime, gOldTime: LONGINT;
|
||||
gTheEvent: EventRecord;
|
||||
gLastFont: INTEGER;
|
||||
gCurrentStyle: Style;
|
||||
|
||||
{>>}
|
||||
procedure CheckStyles;
|
||||
var
|
||||
styleMenu: MenuHandle;
|
||||
begin
|
||||
styleMenu := GetMHandle(STYLE_MENU_ID);
|
||||
Checkitem(styleMenu, PLAIN_ITEM, (gCurrentStyle = PLAIN));
|
||||
Checkitem(styleMenu, BOLD_ITEM, (bold in gCurrentStyle));
|
||||
Checkitem(styleMenu, ITALIC_ITEM, (italic in gCurrentStyle));
|
||||
Checkitem(styleMenu, UNDERLINE_ITEM, (underline in gCurrentStyle));
|
||||
Checkitem(styleMenu, OUTLINE_ITEM, (outline in gCurrentStyle));
|
||||
Checkitem(styleMenu, SHADOW_ITEM, (shadow in gCurrentStyle));
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleStyleChoice (theitem: INTEGER);
|
||||
begin
|
||||
case theitem of
|
||||
PLAIN_ITEM:
|
||||
gCurrentStyle := PLAIN;
|
||||
BOLD_ITEM:
|
||||
if bold in gCurrentStyle then
|
||||
gCurrentStyle := gCurrentStyle - [bold]
|
||||
else
|
||||
gCurrentStyle := gCurrentStyle + [bold];
|
||||
ITALIC_ITEM:
|
||||
if italic in gCurrentStyle then
|
||||
gCurrentStyle := gCurrentStyle - [italic]
|
||||
else
|
||||
gCurrentStyle := gCurrentStyle + [italic];
|
||||
UNDERLINE_ITEM:
|
||||
if underline in gCurrentStyle then
|
||||
gCurrentStyle := gCurrentStyle - [underline]
|
||||
else
|
||||
gCurrentStyle := gCurrentStyle + [underline];
|
||||
OUTLINE_ITEM:
|
||||
if outline in gCurrentStyle then
|
||||
gCurrentStyle := gCurrentStyle - [outline]
|
||||
else
|
||||
gCurrentStyle := gCurrentStyle + [outline];
|
||||
SHADOW_ITEM:
|
||||
if shadow in gCurrentStyle then
|
||||
gCurrentStyle := gCurrentStyle - [shadow]
|
||||
else
|
||||
gCurrentStyle := gCurrentStyle + [shadow];
|
||||
end;
|
||||
CheckStyles;
|
||||
TextFace(gCurrentStyle);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleFontChoice (theItem: INTEGER);
|
||||
var
|
||||
fontNumber: INTEGER;
|
||||
fontName: Str255;
|
||||
fontMenu: MenuHandle;
|
||||
begin
|
||||
fontMenu := GetMHandle(FONT_MENU_ID);
|
||||
CheckItem(fontMenu, glastFont, REMOVE_CHECK_MARK);
|
||||
CheckItem(fontMenu, theItem, ADD_CHECK_MARK);
|
||||
gLastFont := theItem;
|
||||
GetItem(fontMenu, theItem, fontName);
|
||||
GetFNum(fontName, fontNumber);
|
||||
TextFont(fontNumber);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleFileChoice (theItem: INTEGER);
|
||||
begin
|
||||
case theItem of
|
||||
QUIT_ITEM:
|
||||
gDone := TRUE;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleAppleChoice (theItem: INTEGER);
|
||||
var
|
||||
accName: Str255;
|
||||
accNumber, itemNumber, dummy: INTEGER;
|
||||
appleMenu: MenuHandle;
|
||||
begin
|
||||
case theItem of
|
||||
ABOUT_ITEM:
|
||||
dummy := NoteAlert(ABOUT_ALERT, nil);
|
||||
otherwise
|
||||
begin
|
||||
appleMenu := GetMHandle(APPLE_MENU_ID);
|
||||
GetItem(appleMenu, theItem, accName);
|
||||
accNumber := OpenDeskAcc(accName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleMenuChoice (menuChoice: LONGINT);
|
||||
var
|
||||
theMenu, theitem: INTEGER;
|
||||
begin
|
||||
if menuChoice <> 0 then
|
||||
begin
|
||||
theMenu := HiWord(menuChoice);
|
||||
theitem := LoWord(menuChoice);
|
||||
case theMenu of
|
||||
APPLE_MENU_ID:
|
||||
HandleAppleChoice(theItem);
|
||||
FILE_MENU_ID:
|
||||
HandleFileChoice(theItem);
|
||||
FONT_MENU_ID:
|
||||
HandleFontChoice(theItem);
|
||||
STYLE_MENU_ID:
|
||||
HandleStyleChoice(theItem);
|
||||
end;
|
||||
HiliteMenu(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleMouseDown;
|
||||
var
|
||||
whichWindow: WindowPtr;
|
||||
thePart: INTEGER;
|
||||
menuChoice, windSize: LONGINT;
|
||||
begin
|
||||
thePart := FindWindow(gTheEvent.where, whichWindow);
|
||||
case thePart of
|
||||
inMenuBar:
|
||||
begin
|
||||
menuChoice := MenuSelect(gTheEvent.where);
|
||||
HandleMenuChoice(menuChoice);
|
||||
end;
|
||||
inSysWindow:
|
||||
SystemClick(gTheEvent, whichWindow);
|
||||
inDrag:
|
||||
DragWindow(whichWindow, gTheEvent.where, screenBits.bounds);
|
||||
inGoAway:
|
||||
gDone := TRUE;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure DrawClock (theWindow: WindowPtr);
|
||||
var
|
||||
myTimeString: Str255;
|
||||
begin
|
||||
IUTimeString(gCurrentTime, INCLUDE_SECONDS, myTimeString);
|
||||
EraseRect(theWindow^.portRect);
|
||||
MoveTo(CLOCK_LEFT, CLOCK_TOP);
|
||||
DrawString(myTimeString);
|
||||
gOldTime := gCurrentTime;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleNull;
|
||||
begin
|
||||
GetDateTime(gCurrentTime);
|
||||
if gCurrentTime <> gOldTime then
|
||||
DrawClock(gClockWindow);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure HandleEvent;
|
||||
var
|
||||
theChar: CHAR;
|
||||
dummy: BOOLEAN;
|
||||
begin
|
||||
if gWNEimplemented then
|
||||
dummy := WaitNextEvent(everyEvent, gTheEvent, SLEEP, nil)
|
||||
else
|
||||
begin
|
||||
SystemTask;
|
||||
dummy := GetNextEvent(everyEvent, gTheEvent);
|
||||
end;
|
||||
case gTheEvent.what of
|
||||
nullEvent:
|
||||
HandleNull;
|
||||
mouseDown:
|
||||
HandleMouseDown;
|
||||
keyDown, autoKey:
|
||||
begin
|
||||
theChar := CHR(BitAnd(gTheEvent.message, charCodeMask));
|
||||
if (BitAnd(gTheEvent.modifiers, cmdKey) <> 0) then
|
||||
HandleMenuChoice(MenuKey(theChar));
|
||||
end;
|
||||
updateEvt:
|
||||
begin
|
||||
BeginUpdate(WindowPtr(gTheEvent.message));
|
||||
EndUpdate(WindowPtr(gTheEvent.message));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure MainLoop;
|
||||
begin
|
||||
gDone := FALSE;
|
||||
gWNEimplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPL_TRAP_NUM, ToolTrap));
|
||||
while (gDone = FALSE) do
|
||||
HandleEvent;
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure MenuBarInit;
|
||||
var
|
||||
myMenuBar: Handle;
|
||||
aMenu: MenuHandle;
|
||||
begin
|
||||
myMenuBar := GetNewMBar(BASE_RES_ID);
|
||||
SetMenuBar(myMenuBar);
|
||||
DisposHandle(myMenuBar);
|
||||
aMenu := GetMHandle(APPLE_MENU_ID);
|
||||
AddResMenu(aMenu, 'DRVR');
|
||||
aMenu := GetMenu(FONT_MENU_ID);
|
||||
InsertMenu(aMenu, NOT_A_NORMAL_MENU);
|
||||
AddResMenu(aMenu, 'FONT');
|
||||
aMenu := GetMenu(STYLE_MENU_ID);
|
||||
InsertMenu(aMenu, NOT_A_NORMAL_MENU);
|
||||
Checkitem(aMenu, PLAIN_ITEM, TRUE);
|
||||
DrawMenuBar;
|
||||
gLastFont := 1;
|
||||
gCurrentStyle := PLAIN;
|
||||
HandleFontChoice(gLastFont);
|
||||
end;
|
||||
|
||||
{>>}
|
||||
procedure Windowinit;
|
||||
begin
|
||||
gClockWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
|
||||
SetPort(gClockWindow);
|
||||
ShowWindow(gClockWindow);
|
||||
TextSize(CLOCK_SIZE);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
Windowinit;
|
||||
MenuBarInit;
|
||||
DrawClock(gClockWindow);
|
||||
MainLoop;
|
||||
|
||||
end.
|
78
projects/mpw.pict.p
Normal file
78
projects/mpw.pict.p
Normal file
@ -0,0 +1,78 @@
|
||||
program readPICT;
|
||||
{the following variable must be at the top level}
|
||||
|
||||
VAR
|
||||
globalRef : INTEGER; {refNum of the file to read from}
|
||||
|
||||
{the following procedure must be at the top level}
|
||||
|
||||
PROCEDURE GetPICTData(dataPtr: Ptr; byteCount: INTEGER);
|
||||
{replacement for the QuickDraw bottleneck routine}
|
||||
|
||||
VAR
|
||||
err : OSErr;
|
||||
longCount : LONGINT;
|
||||
|
||||
BEGIN
|
||||
longCount := byteCount;
|
||||
err := FSRead(globalRef,longCount,dataPtr);
|
||||
{can't check for an error because we don't know how to handle it}
|
||||
END;
|
||||
|
||||
CONST
|
||||
abortPICT = 128; {error code if DrawPicture aborted}
|
||||
|
||||
PROCEDURE GetDrawPICTFile; {read in a PICT FILE selected by the user}
|
||||
|
||||
VAR
|
||||
wher : Point; {where to display dialog}
|
||||
reply : SFReply; {reply record}
|
||||
myFileTypes : SFTypeList; {more Standard FILE goodies}
|
||||
numFileTypes: INTEGER;
|
||||
|
||||
savedProcs : QDProcsPtr;
|
||||
myProcs : QDProcs; {use CQDProcs for a color window}
|
||||
|
||||
myPicture : PicHandle; {we need a picture handle for DrawPicture}
|
||||
longCount : LONGINT;
|
||||
myEOF : LONGINT;
|
||||
myFilePos : LONGINT;
|
||||
|
||||
BEGIN
|
||||
wher.h := 20;
|
||||
wher.v := 20;
|
||||
numFileTypes := 1; {display PICT files}
|
||||
myFileTypes[0] := 'PICT';
|
||||
SFGetFile(wher,'',NIL,numFileTypes,myFileTypes,NIL,reply);
|
||||
|
||||
IF reply.good THEN BEGIN
|
||||
SetStdProcs(myProcs); {use SetStdCProcs for a CGrafPort}
|
||||
myProcs.getPicProc := @GetPICTData;
|
||||
savedProcs := thePort^.grafProcs; {set the grafProcs to ours}
|
||||
thePort^.grafProcs := @myProcs;
|
||||
|
||||
myPicture := PicHandle(NewHandle(SizeOf(myPicture)));
|
||||
|
||||
Signal(FSOpen(reply.fname,reply.vRefNum,globalRef));
|
||||
Signal(GetEOF(globalRef,myEOF)); {get EOF for later check}
|
||||
Signal(SetFPos(globalRef,fsFromStart,512)); {skip header}
|
||||
|
||||
{read in the (obsolete) size word and the picFrame}
|
||||
longCount := SizeOf(myPicture);
|
||||
Signal(FSRead(globalRef,longCount,Ptr(myPicture^)));
|
||||
|
||||
DrawPicture(myPicture,myPicture^^.picFrame); {draw the picture}
|
||||
|
||||
Signal(GetFPos(globalRef,filePos)); {get position for check}
|
||||
Signal(FSClose(globalRef));
|
||||
|
||||
DisposHandle(Handle(myPicture));
|
||||
|
||||
thePort^.grafProcs := savedProcs; {restore the procs}
|
||||
|
||||
{Check for errors. If there wasn't enough room,}
|
||||
{DrawPicture will abort; the FILE position mark}
|
||||
{won't be at the end of the FILE.}
|
||||
IF filePos <> myEOF THEN Signal(abortPICT);
|
||||
END; {IF reply.good}
|
||||
END; {GetDrawPICTFile}
|
Loading…
Reference in New Issue
Block a user