mirror of
https://github.com/jrk/QuickDraw.git
synced 2025-03-19 17:30:05 +00:00
972 lines
24 KiB
OpenEdge ABL
Executable File
972 lines
24 KiB
OpenEdge ABL
Executable File
PROGRAM TestGraf;
|
|
|
|
{ Quick Checkout for QuickDraw }
|
|
|
|
USES {$U obj:QuickDraw } QuickDraw,
|
|
{$U obj:QDSupport } QDSupport,
|
|
{$U obj:GrafUtil } GrafUtil;
|
|
|
|
LABEL 1;
|
|
|
|
CONST heapSize = $10000; { 64k bytes }
|
|
|
|
TYPE IconData = ARRAY[0..95] OF INTEGER;
|
|
|
|
VAR heapStart: QDPtr;
|
|
heapLimit: QDPtr;
|
|
port1: GrafPtr;
|
|
tempRect: Rect;
|
|
myPoly: PolyHandle;
|
|
myRgn: RgnHandle;
|
|
myPattern: Pattern;
|
|
myPicture: PicHandle;
|
|
bigPicture: PicHandle;
|
|
icons: ARRAY[0..5] OF IconData;
|
|
i,errNum: INTEGER;
|
|
numerArray: ARRAY[0..30] OF INTEGER;
|
|
denomArray: ARRAY[0..30] OF INTEGER;
|
|
srcRect: Rect;
|
|
dstRect: Rect;
|
|
ch: CHAR;
|
|
|
|
|
|
|
|
FUNCTION HeapError(hz: QDPtr; bytesNeeded: INTEGER): INTEGER;
|
|
{ this function will be called if the heapZone runs out of space }
|
|
BEGIN
|
|
WRITELN('The heap is full. User Croak !! ');
|
|
Halt;
|
|
END;
|
|
|
|
|
|
PROCEDURE InitIcons;
|
|
{ Manually stuff some icons. Normally we would read them from a file }
|
|
BEGIN
|
|
{ Lisa }
|
|
StuffHex(@icons[0, 0],'000000000000000000000000000000000000001FFFFFFFFC');
|
|
StuffHex(@icons[0,12],'00600000000601800000000B0600000000130FFFFFFFFFA3');
|
|
StuffHex(@icons[0,24],'18000000004311FFFFF00023120000080F231200000BF923');
|
|
StuffHex(@icons[0,36],'120000080F23120000080023120000080023120000080F23');
|
|
StuffHex(@icons[0,48],'1200000BF923120000080F2312000008002311FFFFF00023');
|
|
StuffHex(@icons[0,60],'08000000004307FFFFFFFFA30100000000260FFFFFFFFE2C');
|
|
StuffHex(@icons[0,72],'18000000013832AAAAA8A9F0655555515380C2AAAA82A580');
|
|
StuffHex(@icons[0,84],'800000000980FFFFFFFFF300800000001600FFFFFFFFFC00');
|
|
|
|
{ Printer }
|
|
StuffHex(@icons[1, 0],'000000000000000000000000000000000000000000000000');
|
|
StuffHex(@icons[1,12],'00000000000000007FFFFF00000080000280000111514440');
|
|
StuffHex(@icons[1,24],'0002000008400004454510400004000017C00004A5151000');
|
|
StuffHex(@icons[1,36],'0004000010000004A54510000004000017FE00F4A5151003');
|
|
StuffHex(@icons[1,48],'0184000013870327FFFFF10F06400000021B0CFFFFFFFC37');
|
|
StuffHex(@icons[1,60],'18000000006B3000000000D77FFFFFFFFFABC00000000356');
|
|
StuffHex(@icons[1,72],'8000000001AC87F000000158841000CCC1B087F000CCC160');
|
|
StuffHex(@icons[1,84],'8000000001C0C000000003807FFFFFFFFF0007800001E000');
|
|
|
|
{ Trash Can }
|
|
StuffHex(@icons[2, 0],'000001FC000000000E0600000000300300000000C0918000');
|
|
StuffHex(@icons[2,12],'00013849800000026C4980000004C0930000000861260000');
|
|
StuffHex(@icons[2,24],'0010064FE0000031199830000020E6301800002418E00800');
|
|
StuffHex(@icons[2,36],'0033E3801C0000180E002C00000FF801CC0000047FFE0C00');
|
|
StuffHex(@icons[2,48],'000500004C000005259A4C000005250A4C00000525FA4C00');
|
|
StuffHex(@icons[2,60],'000524024C00000524924C00600524924C0090E524924C7C');
|
|
StuffHex(@icons[2,72],'932524924C82A44524924D01C88524924CF10C4524924C09');
|
|
StuffHex(@icons[2,84],'0784249258E70003049233100000E000E40800001FFFC3F0');
|
|
|
|
{ tray }
|
|
StuffHex(@icons[3, 0],'000000000000000000000000000000000000000000000000');
|
|
StuffHex(@icons[3,12],'0000000000000000000000000000000000000007FFFFFFF0');
|
|
StuffHex(@icons[3,24],'000E00000018001A00000038003600000078006A000000D8');
|
|
StuffHex(@icons[3,36],'00D7FFFFFFB801AC000003580358000006B807FC000FFD58');
|
|
StuffHex(@icons[3,48],'040600180AB80403FFF00D58040000000AB8040000000D58');
|
|
StuffHex(@icons[3,60],'040000000AB807FFFFFFFD5806AC00000AB8055800000D58');
|
|
StuffHex(@icons[3,72],'06B000000AB807FC000FFD70040600180AE00403FFF00DC0');
|
|
StuffHex(@icons[3,84],'040000000B80040000000F00040000000E0007FFFFFFFC00');
|
|
|
|
{ File Cabinet }
|
|
StuffHex(@icons[4, 0],'0007FFFFFC00000800000C00001000001C00002000003400');
|
|
StuffHex(@icons[4,12],'004000006C0000FFFFFFD40000800000AC0000BFFFFED400');
|
|
StuffHex(@icons[4,24],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
|
|
StuffHex(@icons[4,36],'00A00002AC0000A08082D40000A0FF82AC0000A00002D400');
|
|
StuffHex(@icons[4,48],'00A00002AC0000BFFFFED40000800000AC0000BFFFFED400');
|
|
StuffHex(@icons[4,60],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
|
|
StuffHex(@icons[4,72],'00A00002AC0000A08082D40000A0FF82AC0000A00002D800');
|
|
StuffHex(@icons[4,84],'00A00002B00000BFFFFEE00000800000C00000FFFFFF8000');
|
|
|
|
{ drawer }
|
|
StuffHex(@icons[5, 0],'000000000000000000000000000000000000000000000000');
|
|
StuffHex(@icons[5,12],'000000000000000000000000000000000000000000000000');
|
|
StuffHex(@icons[5,24],'000000000000000000000000000000000000000000000000');
|
|
StuffHex(@icons[5,36],'00000000000000000000000000000000000000001FFFFFF0');
|
|
StuffHex(@icons[5,48],'0000380000300000680000700000D80000D0003FFFFFF1B0');
|
|
StuffHex(@icons[5,60],'0020000013500020000016B000201FE01D50002010201AB0');
|
|
StuffHex(@icons[5,72],'00201FE01560002000001AC0002000001580002020101B00');
|
|
StuffHex(@icons[5,84],'00203FF01600002000001C00002000001800003FFFFFF000');
|
|
|
|
END;
|
|
|
|
|
|
PROCEDURE DrawIcon(whichIcon,h,v: INTEGER);
|
|
VAR srcBits: BitMap;
|
|
srcRect,dstRect: Rect;
|
|
BEGIN
|
|
srcBits.baseAddr:=@icons[whichIcon];
|
|
srcBits.rowBytes:=6;
|
|
SetRect(srcBits.bounds,0,0,48,32);
|
|
srcRect:=srcBits.bounds;
|
|
|
|
dstRect:=srcRect;
|
|
OffsetRect(dstRect,h,v);
|
|
CopyBits(srcBits,thePort^.portBits,srcRect,dstRect,srcOr,Nil);
|
|
END;
|
|
|
|
|
|
PROCEDURE DrawStuff;
|
|
VAR i: INTEGER;
|
|
tempRect: Rect;
|
|
srcRect: Rect;
|
|
dstRect: Rect;
|
|
|
|
dataPtr: QDPtr;
|
|
tempStr: Str255;
|
|
|
|
BEGIN
|
|
BackColor(whiteColor);
|
|
ForeColor(blackColor);
|
|
|
|
{ test comments }
|
|
PicComment(100,0,Nil);
|
|
tempStr := 'Hello Test';
|
|
dataPtr := @tempStr;
|
|
PicComment(200,11,@dataPtr);
|
|
|
|
|
|
tempRect := thePort^.portRect;
|
|
ClipRect(tempRect);
|
|
EraseRoundRect(tempRect,30,20);
|
|
FrameRoundRect(tempRect,30,20);
|
|
|
|
{ draw two horizontal lines across the top }
|
|
MoveTo(0,18);
|
|
LineTo(719,18);
|
|
MoveTo(0,20);
|
|
LineTo(719,20);
|
|
|
|
{ draw divider lines }
|
|
MoveTo(0,134);
|
|
LineTo(719,134);
|
|
MoveTo(0,248);
|
|
LineTo(719,248);
|
|
MoveTo(240,21);
|
|
LineTo(240,363);
|
|
MoveTo(480,21);
|
|
LineTo(480,363);
|
|
|
|
{ draw title }
|
|
TextFont(0);
|
|
MoveTo(210,14);
|
|
DrawString('Look what you can draw with QuickDraw');
|
|
|
|
|
|
|
|
{--------- draw text samples --------- }
|
|
|
|
ForeColor(redColor);
|
|
MoveTo(80,34); DrawString('Red');
|
|
|
|
ForeColor(greenColor);
|
|
TextFace([bold]);
|
|
MoveTo(70,55); DrawString('Green');
|
|
|
|
ForeColor(blueColor);
|
|
TextFace([italic]);
|
|
MoveTo(70,70); DrawString('Blue');
|
|
|
|
ForeColor(cyanColor);
|
|
TextFace([underline]);
|
|
MoveTo(70,85); DrawString('Cyan');
|
|
|
|
ForeColor(magentaColor);
|
|
TextFace([outline]);
|
|
MoveTo(70,100); DrawString('Magenta');
|
|
|
|
ForeColor(yellowColor);
|
|
TextFace([shadow]);
|
|
MoveTo(70,115); DrawString('Yellow');
|
|
|
|
TextFace([]); { restore to normal }
|
|
|
|
|
|
|
|
{ --------- draw line samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(330,34); DrawString('Lines');
|
|
|
|
ForeColor(redColor);
|
|
MoveTo(280,25); Line(160,40);
|
|
|
|
ForeColor(greenColor);
|
|
PenSize(3,2);
|
|
MoveTo(280,35); Line(160,40);
|
|
|
|
ForeColor(blueColor);
|
|
PenSize(6,4);
|
|
MoveTo(280,46); Line(160,40);
|
|
|
|
ForeColor(cyanColor);
|
|
PenSize(12,8);
|
|
PenPat(gray);
|
|
MoveTo(280,61); Line(160,40);
|
|
|
|
ForeColor(magentaColor);
|
|
PenSize(15,10);
|
|
PenPat(myPattern);
|
|
MoveTo(280,80); Line(160,40);
|
|
PenNormal;
|
|
|
|
|
|
|
|
{ --------- draw rectangle samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(560,34); DrawString('Rectangles');
|
|
|
|
ForeColor(redColor);
|
|
SetRect(tempRect,510,40,570,70);
|
|
FrameRect(tempRect);
|
|
|
|
ForeColor(greenColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PenSize(3,2);
|
|
EraseRect(tempRect);
|
|
FrameRect(tempRect);
|
|
|
|
ForeColor(blueColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PaintRect(tempRect);
|
|
|
|
ForeColor(cyanColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PenNormal;
|
|
FillRect(tempRect,gray);
|
|
FrameRect(tempRect);
|
|
|
|
ForeColor(magentaColor);
|
|
OffsetRect(tempRect,25,15);
|
|
FillRect(tempRect,myPattern);
|
|
FrameRect(tempRect);
|
|
|
|
|
|
{ --------- draw roundRect samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(70,148); DrawString('RoundRects');
|
|
|
|
ForeColor(redColor);
|
|
SetRect(tempRect,30,150,90,180);
|
|
FrameRoundRect(tempRect,30,20);
|
|
|
|
ForeColor(greenColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PenSize(3,2);
|
|
EraseRoundRect(tempRect,30,20);
|
|
FrameRoundRect(tempRect,30,20);
|
|
|
|
ForeColor(blueColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PaintRoundRect(tempRect,30,20);
|
|
|
|
ForeColor(cyanColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PenNormal;
|
|
FillRoundRect(tempRect,30,20,gray);
|
|
FrameRoundRect(tempRect,30,20);
|
|
|
|
ForeColor(magentaColor);
|
|
OffsetRect(tempRect,25,15);
|
|
FillRoundRect(tempRect,30,20,myPattern);
|
|
FrameRoundRect(tempRect,30,20);
|
|
|
|
|
|
{ --------- draw bitmap samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(320,148); DrawString('BitMaps');
|
|
|
|
ForeColor(redColor);
|
|
DrawIcon(0,266,156);
|
|
ForeColor(greenColor);
|
|
DrawIcon(1,336,156);
|
|
ForeColor(blueColor);
|
|
DrawIcon(2,406,156);
|
|
ForeColor(cyanColor);
|
|
DrawIcon(3,266,196);
|
|
ForeColor(magentaColor);
|
|
DrawIcon(4,336,196);
|
|
ForeColor(yellowColor);
|
|
DrawIcon(5,406,196);
|
|
|
|
|
|
{ --------- draw ARC samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(570,148); DrawString('Arcs');
|
|
|
|
SetRect(tempRect,520,153,655,243);
|
|
ForeColor(redColor);
|
|
FillArc(tempRect,135,65,dkGray);
|
|
ForeColor(greenColor);
|
|
FillArc(tempRect,200,130,myPattern);
|
|
ForeColor(blueColor);
|
|
FillArc(tempRect,330,75,gray);
|
|
ForeColor(cyanColor);
|
|
FrameArc(tempRect,135,270);
|
|
OffsetRect(tempRect,20,0);
|
|
ForeColor(magentaColor);
|
|
PaintArc(tempRect,45,90);
|
|
|
|
|
|
{ --------- draw polygon samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(80,262); DrawString('Polygons');
|
|
|
|
myPoly:=OpenPoly;
|
|
MoveTo(30,290);
|
|
LineTo(30,280);
|
|
LineTo(50,265);
|
|
LineTo(90,265);
|
|
LineTo(80,280);
|
|
LineTo(95,290);
|
|
LineTo(30,290);
|
|
ClosePoly; { end of definition }
|
|
|
|
ForeColor(redColor);
|
|
FramePoly(myPoly);
|
|
|
|
ForeColor(greenColor);
|
|
OffsetPoly(myPoly,25,15);
|
|
PenSize(3,2);
|
|
ErasePoly(myPoly);
|
|
FramePoly(myPoly);
|
|
|
|
ForeColor(blueColor);
|
|
OffsetPoly(myPoly,25,15);
|
|
PaintPoly(myPoly);
|
|
|
|
ForeColor(cyanColor);
|
|
OffsetPoly(myPoly,25,15);
|
|
PenNormal;
|
|
FillPoly(myPoly,gray);
|
|
FramePoly(myPoly);
|
|
|
|
ForeColor(magentaColor);
|
|
OffsetPoly(myPoly,25,15);
|
|
FillPoly(myPoly,myPattern);
|
|
FramePoly(myPoly);
|
|
|
|
KillPoly(myPoly);
|
|
|
|
(*
|
|
|
|
{ --------- draw region samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(80,262); DrawString('Regions');
|
|
|
|
myRgn := NewRgn;
|
|
OpenRgn;
|
|
MoveTo(30,290);
|
|
LineTo(30,280);
|
|
LineTo(50,265);
|
|
LineTo(90,265);
|
|
LineTo(80,280);
|
|
LineTo(95,290);
|
|
LineTo(30,290);
|
|
CloseRgn(myRgn); { end of definition }
|
|
|
|
ForeColor(redColor);
|
|
FrameRgn(myRgn);
|
|
|
|
ForeColor(greenColor);
|
|
OffsetRgn(myRgn,25,15);
|
|
PenSize(3,2);
|
|
EraseRgn(myRgn);
|
|
FrameRgn(myRgn);
|
|
|
|
ForeColor(blueColor);
|
|
OffsetRgn(myRgn,25,15);
|
|
PaintRgn(myRgn);
|
|
|
|
ForeColor(cyanColor);
|
|
OffsetRgn(myRgn,25,15);
|
|
PenNormal;
|
|
FillRgn(myRgn,gray);
|
|
FrameRgn(myRgn);
|
|
|
|
ForeColor(magentaColor);
|
|
OffsetRgn(myRgn,25,15);
|
|
FillRgn(myRgn,myPattern);
|
|
FrameRgn(myRgn);
|
|
|
|
DisposeRgn(myRgn);
|
|
|
|
*)
|
|
|
|
{ --------- demonstrate region clipping --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(320,262); DrawString('Regions');
|
|
|
|
myRgn:=NewRgn;
|
|
OpenRgn;
|
|
ShowPen;
|
|
|
|
ForeColor(yellowColor);
|
|
SetRect(tempRect,260,270,460,350);
|
|
FrameRoundRect(tempRect,24,16);
|
|
|
|
MoveTo(275,335); { define triangular hole }
|
|
LineTo(325,285);
|
|
LineTo(375,335);
|
|
LineTo(275,335);
|
|
|
|
SetRect(tempRect,365,277,445,325); { oval hole }
|
|
FrameOval(tempRect);
|
|
|
|
HidePen;
|
|
CloseRgn(myRgn); { end of definition }
|
|
|
|
SetClip(myRgn);
|
|
|
|
BackColor(blueColor);
|
|
ForeColor(greenColor);
|
|
FOR i:=0 TO 6 DO { draw stuff inside the clip region }
|
|
BEGIN
|
|
MoveTo(260,280+12*i);
|
|
DrawString('Arbitrary Clipping Regions');
|
|
END;
|
|
BackColor(whiteColor);
|
|
|
|
ClipRect(thePort^.portRect);
|
|
DisposeRgn(myRgn);
|
|
|
|
|
|
{ --------- draw oval samples --------- }
|
|
|
|
ForeColor(blackColor);
|
|
MoveTo(580,262); DrawString('Ovals');
|
|
|
|
ForeColor(redColor);
|
|
SetRect(tempRect,510,264,570,294);
|
|
FrameOval(tempRect);
|
|
|
|
ForeColor(greenColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PenSize(3,2);
|
|
EraseOval(tempRect);
|
|
FrameOval(tempRect);
|
|
|
|
ForeColor(blueColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PaintOval(tempRect);
|
|
|
|
ForeColor(cyanColor);
|
|
OffsetRect(tempRect,25,15);
|
|
PenNormal;
|
|
FillOval(tempRect,gray);
|
|
FrameOval(tempRect);
|
|
|
|
ForeColor(magentaColor);
|
|
OffsetRect(tempRect,25,15);
|
|
FillOval(tempRect,myPattern);
|
|
FrameOval(tempRect);
|
|
|
|
BackColor(whiteColor);
|
|
ForeColor(blackColor);
|
|
|
|
{ test large CopyBits }
|
|
SetRect(srcRect,0,0,200,100);
|
|
SetRect(dstRect,50,50,250,150);
|
|
CopyBits(thePort^.portBits,thePort^.portBits,srcRect,dstRect,0,Nil);
|
|
|
|
END; { DrawStuff }
|
|
|
|
|
|
PROCEDURE InitScales;
|
|
{ initialize an array of common scale factors }
|
|
BEGIN
|
|
numerArray[ 0] := 1; denomArray[ 0] := 8;
|
|
numerArray[ 1] := 1; denomArray[ 1] := 4;
|
|
numerArray[ 2] := 1; denomArray[ 2] := 3;
|
|
numerArray[ 3] := 3; denomArray[ 3] := 8;
|
|
numerArray[ 4] := 1; denomArray[ 4] := 2;
|
|
numerArray[ 5] := 2; denomArray[ 5] := 3;
|
|
numerArray[ 6] := 3; denomArray[ 6] := 4;
|
|
numerArray[ 7] := 1; denomArray[ 7] := 1;
|
|
numerArray[ 8] := 4; denomArray[ 8] := 3;
|
|
numerArray[ 9] := 3; denomArray[ 9] := 2;
|
|
numerArray[10] := 2; denomArray[10] := 1;
|
|
numerArray[11] := 3; denomArray[11] := 1;
|
|
numerArray[12] := 4; denomArray[12] := 1;
|
|
numerArray[13] := 6; denomArray[13] := 1;
|
|
numerArray[14] := 8; denomArray[14] := 1;
|
|
numerArray[15] := 16; denomArray[15] := 1;
|
|
numerArray[16] := 24; denomArray[16] := 1;
|
|
numerArray[17] := 32; denomArray[17] := 1;
|
|
numerArray[18] := 40; denomArray[18] := 1;
|
|
numerArray[19] := 48; denomArray[19] := 1;
|
|
numerArray[20] := 56; denomArray[20] := 1;
|
|
numerArray[21] := 64; denomArray[21] := 1;
|
|
END;
|
|
|
|
|
|
PROCEDURE SetScale(numer,denom: LongInt);
|
|
BEGIN
|
|
WITH dstRect DO
|
|
BEGIN
|
|
left := 360 - (360 * numer) DIV denom;
|
|
right := 360 + (360 * numer) DIV denom;
|
|
top := 182 - (182 * numer) DIV denom;
|
|
bottom:= 182 + (182 * numer) DIV denom;
|
|
END;
|
|
END;
|
|
|
|
|
|
PROCEDURE DumpPicture(myPicture: PicHandle);
|
|
LABEL 1;
|
|
VAR ch: CHAR;
|
|
i,byteCount: INTEGER;
|
|
count,total: INTEGER;
|
|
picPtr: QDPtr;
|
|
opCode,hiNibble,loNibble: INTEGER;
|
|
sameFlag: BOOLEAN;
|
|
srcBits: BitMap;
|
|
|
|
FUNCTION GetWord: INTEGER;
|
|
VAR word: INTEGER;
|
|
BEGIN
|
|
word := BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
word := BitShift(word,+8) + BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
GetWord := word;
|
|
END;
|
|
|
|
FUNCTION GetSByte: INTEGER;
|
|
BEGIN
|
|
GetSByte := picPtr^;
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
END;
|
|
|
|
FUNCTION GetUByte: INTEGER;
|
|
BEGIN
|
|
GetUByte := BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
END;
|
|
|
|
FUNCTION GetLong: LongInt;
|
|
VAR long: LongInt;
|
|
BEGIN
|
|
long := BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
long := BitShift(long,+8) + BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
long := BitShift(long,+8) + BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
long := BitShift(long,+8) + BitAnd(picPtr^,$FF);
|
|
picPtr := Pointer(ORD(picPtr)+1);
|
|
GetLong := long;
|
|
END;
|
|
|
|
BEGIN
|
|
WRITELN;
|
|
WRITELN('picSize = ',myPicture^^.picSize,' bytes');
|
|
WITH myPicture^^.picFrame DO
|
|
WRITELN('picFrame = (',left:1,',',top:1,',',right:1,',',bottom:1,')');
|
|
|
|
picPtr := Pointer(ORD(myPicture^) + 10);
|
|
|
|
1: opCode := GetSByte;
|
|
WRITELN;
|
|
IF opCode = -1 THEN EXIT(DumpPicture);
|
|
|
|
loNibble := BitAnd(opCode,$F);
|
|
hiNibble := BitShift(BitAnd(opCode,$F0),-4);
|
|
|
|
IF hiNibble = 0 THEN
|
|
BEGIN
|
|
CASE loNibble OF
|
|
|
|
1: BEGIN
|
|
WRITE('Set clipRgn ');
|
|
byteCount := GetWord;
|
|
WRITE('rgnSize = ',byteCount);
|
|
picPtr := Pointer(ORD(picPtr) + byteCount - 2);
|
|
END;
|
|
|
|
2: BEGIN
|
|
WRITE('Set bkPat');
|
|
picPtr := Pointer(ORD(picPtr) + 8);
|
|
END;
|
|
|
|
3: BEGIN
|
|
WRITE('Set txFont ',GetWord);
|
|
END;
|
|
|
|
4: BEGIN
|
|
WRITE('Set txFace ',GetUByte);
|
|
END;
|
|
|
|
5: BEGIN
|
|
WRITE('Set txMode ',GetWord);
|
|
END;
|
|
|
|
6: BEGIN
|
|
WRITE('Set spExtra ',GetWord);
|
|
END;
|
|
|
|
7: BEGIN
|
|
WRITE('Set pnSize ',GetWord,GetWord);
|
|
END;
|
|
|
|
8: BEGIN
|
|
WRITE('Set pnMode ',GetWord);
|
|
END;
|
|
|
|
9: BEGIN
|
|
WRITE('Set pnPat');
|
|
picPtr := Pointer(ORD(picPtr) + 8);
|
|
END;
|
|
|
|
10: BEGIN
|
|
WRITE('Set thePat');
|
|
picPtr := Pointer(ORD(picPtr) + 8);
|
|
END;
|
|
|
|
11: BEGIN
|
|
WRITE('Set ovalSize ',GetWord,GetWord);
|
|
END;
|
|
|
|
12: BEGIN
|
|
WRITE('Set Origin ',GetWord,GetWord);
|
|
END;
|
|
|
|
13: BEGIN
|
|
WRITE('Set txSize ',GetWord);
|
|
END;
|
|
|
|
14: BEGIN
|
|
WRITE('Set ForeColor ',GetLong);
|
|
END;
|
|
|
|
15: BEGIN
|
|
WRITE('Set BackColor ',GetLong);
|
|
END;
|
|
|
|
END; { case }
|
|
GOTO 1;
|
|
END; { if hiNibble = 0 }
|
|
|
|
|
|
IF hiNibble = 1 THEN
|
|
BEGIN
|
|
CASE loNibble OF
|
|
|
|
0: BEGIN
|
|
WRITE('txNumer,txDenom = ',GetWord,GetWord,GetWord,GetWord);
|
|
END;
|
|
|
|
1: BEGIN
|
|
WRITE('picVersion = ',GetUByte);
|
|
END;
|
|
|
|
OTHERWISE WRITE('OOPS ! OPCODE WAS ',opCode);
|
|
END; { case }
|
|
GOTO 1;
|
|
END; { if hiNibble = 1 }
|
|
|
|
|
|
IF hiNibble = 2 THEN
|
|
BEGIN { text or line }
|
|
CASE loNibble OF
|
|
0: WRITE('Line from ',GetWord,GetWord,' to ',GetWord,GetWord);
|
|
1: WRITE('Line to ',GetWord,GetWord);
|
|
2: WRITE('Line from ',GetWord,GetWord, ' dh,dv = ',GetSByte,GetSByte);
|
|
3: WRITE('Line dh,dv = ',GetSByte,GetSByte);
|
|
8,9,10,11:
|
|
BEGIN { text }
|
|
CASE loNibble OF
|
|
8: WRITE('LongText at ',GetWord,GetWord,' ');
|
|
9: WRITE('DH Text, dh = ',GetUByte,' ');
|
|
10: WRITE('DV Text, dv = ',GetUByte,' ');
|
|
11: WRITE('DHDV Text, dh,dv = ',GetUByte,GetUByte,' ');
|
|
END;
|
|
byteCount := GetUByte;
|
|
FOR i:= 1 to byteCount DO WRITE(CHR(GetUByte));
|
|
END;
|
|
END; { case loNibble }
|
|
GOTO 1;
|
|
END;
|
|
|
|
|
|
IF hiNibble = 9 THEN WITH srcBits, bounds DO
|
|
BEGIN
|
|
sameFlag := FALSE; { not packed }
|
|
IF BitAnd(loNibble,$8) <> 0 THEN
|
|
BEGIN
|
|
sameFlag := TRUE; { packed }
|
|
loNibble := BitAnd(loNibble,$7);
|
|
WRITE('Pack');
|
|
END;
|
|
|
|
IF loNibble = 0
|
|
THEN WRITELN('BitsRect: ') ELSE WRITELN('BitsRgn: ');
|
|
rowBytes := GetWord;
|
|
top := GetWord;
|
|
left := GetWord;
|
|
bottom := GetWord;
|
|
right := GetWord;
|
|
|
|
WRITELN(' rowBytes = ',rowBytes);
|
|
WRITELN(' bounds = ',top,left,bottom,right);
|
|
WRITELN(' srcRect = ',GetWord,GetWord,GetWord,GetWord);
|
|
WRITELN(' dstRect = ',GetWord,GetWord,GetWord,GetWord);
|
|
WRITELN(' mode = ',GetWord);
|
|
IF loNibble <> 0 THEN
|
|
BEGIN
|
|
byteCount := GetWord;
|
|
WRITELN(' maskRgn rgnSize = ',byteCount);
|
|
picPtr := Pointer(ORD(picPtr) + byteCount-2);
|
|
END;
|
|
byteCount := rowBytes*(bottom-top);
|
|
IF sameFlag THEN
|
|
BEGIN
|
|
total := 0;
|
|
FOR i := top TO bottom - 1 DO
|
|
BEGIN
|
|
count := GetUByte;
|
|
total := total + count;
|
|
picPtr := Pointer(ORD(picPtr) + count);
|
|
END;
|
|
WRITELN(' ',byteCount:1,' bytes compressed to ',total);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
WRITELN(' Uncompressed bytes = ',byteCount);
|
|
picPtr := Pointer(ORD(picPtr) + byteCount);
|
|
END;
|
|
GOTO 1;
|
|
END;
|
|
|
|
IF hiNibble = 10 THEN
|
|
BEGIN
|
|
IF loNibble = 0 THEN
|
|
BEGIN
|
|
WRITE('Short Comment ',GetWord);
|
|
GOTO 1;
|
|
END;
|
|
|
|
WRITE('Long Comment ',GetWord);
|
|
byteCount := GetWord;
|
|
picPtr := Pointer(ORD(picPtr) + byteCount);
|
|
GOTO 1;
|
|
END;
|
|
|
|
IF hiNibble > 10 THEN
|
|
BEGIN
|
|
WRITE('OOPS, hiNibble > 10 ! opcode was ',opCode);
|
|
READLN;
|
|
GOTO 1;
|
|
END;
|
|
|
|
|
|
{ hi nibble is 3..8 }
|
|
|
|
sameFlag := FALSE;
|
|
IF BitAnd(loNibble,$8) <> 0 THEN
|
|
BEGIN
|
|
sameFlag := TRUE;
|
|
loNibble := BitAnd(loNibble,$7);
|
|
END;
|
|
|
|
CASE loNibble OF
|
|
0: WRITE('Frame');
|
|
1: WRITE('Paint');
|
|
2: WRITE('Erase');
|
|
3: WRITE('Invert');
|
|
4: WRITE('Fill');
|
|
END;
|
|
|
|
IF sameFlag THEN WRITE('Same');
|
|
|
|
CASE hiNibble OF
|
|
3: BEGIN
|
|
WRITE('Rect');
|
|
IF NOT sameFlag THEN WRITE(GetWord,GetWord,GetWord,GetWord);
|
|
END;
|
|
|
|
4: BEGIN
|
|
WRITE('RRect');
|
|
IF NOT sameFlag THEN WRITE(GetWord,GetWord,GetWord,GetWord);
|
|
END;
|
|
|
|
5: BEGIN
|
|
WRITE('Oval');
|
|
IF NOT sameFlag THEN WRITE(GetWord,GetWord,GetWord,GetWord);
|
|
END;
|
|
|
|
6: BEGIN
|
|
WRITE('Arc');
|
|
IF NOT sameFlag THEN WRITE(GetWord,GetWord,GetWord,GetWord);
|
|
WRITE(GetWord,GetWord);
|
|
END;
|
|
|
|
7: BEGIN
|
|
WRITE('Poly');
|
|
byteCount := GetWord;
|
|
WRITE(' polySize = ',byteCount);
|
|
picPtr := Pointer(ORD(picPtr) + byteCount-2);
|
|
END;
|
|
|
|
8: BEGIN
|
|
WRITE('Rgn');
|
|
byteCount := GetWord;
|
|
WRITE(' rgnSize = ',byteCount);
|
|
picPtr := Pointer(ORD(picPtr) + byteCount-2);
|
|
END;
|
|
|
|
END;
|
|
|
|
GOTO 1;
|
|
|
|
END;
|
|
|
|
|
|
BEGIN { main program }
|
|
WRITE('Press return '); READLN;
|
|
NEW(heapStart);
|
|
heapLimit:=Pointer(ORD(heapStart)+heapSize);
|
|
RELEASE(heapLimit); { forward release to allocate }
|
|
InitHeap(heapStart,heapLimit,@heapError);
|
|
InitGraf(@thePort);
|
|
|
|
InitCursor;
|
|
HideCursor;
|
|
FMInit(errNum);
|
|
IF errNum <> 0 THEN
|
|
BEGIN
|
|
WRITELN('FMInit says errNum=',errNum);
|
|
HALT;
|
|
END;
|
|
|
|
StuffHex(@myPattern,'8040200002040800');
|
|
|
|
InitIcons;
|
|
InitScales;
|
|
|
|
NEW(port1);
|
|
OpenPort(port1);
|
|
PaintRect(thePort^.portRect);
|
|
DrawStuff;
|
|
READLN;
|
|
|
|
myPicture := OpenPicture(thePort^.portRect);
|
|
DrawStuff;
|
|
ClosePicture;
|
|
WRITELN('picSize = ',myPicture^^.picSize:1);
|
|
READLN;
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
WRITE('Dump ?'); READ(ch); WRITELN;
|
|
IF ch IN ['Y','y'] THEN
|
|
BEGIN
|
|
DumpPicture(myPicture);
|
|
READLN;
|
|
END;
|
|
|
|
WRITE('ABOUT TO make bigPicture '); READLN;
|
|
bigPicture := OpenPicture(thePort^.portRect);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
tempRect := thePort^.portRect;
|
|
InsetRect(tempRect,100,50);
|
|
DrawPicture(myPicture,tempRect);
|
|
InsetRect(tempRect,100,50);
|
|
DrawPicture(myPicture,tempRect);
|
|
ClosePicture;
|
|
WRITELN('big picSize = ',bigPicture^^.picSize:1);
|
|
READLN;
|
|
DrawPicture(bigPicture,thePort^.portRect);
|
|
|
|
WRITE('Dump Big ?'); READ(ch); WRITELN;
|
|
IF ch IN ['Y','y'] THEN
|
|
BEGIN
|
|
DumpPicture(bigPicture);
|
|
READLN;
|
|
END;
|
|
|
|
KillPicture(bigPicture);
|
|
|
|
WRITE('ABOUT TO DO NORMAL from picture '); READLN;
|
|
ColorBit(normalBit);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
WRITE('ABOUT TO DO INVERSE from picture '); READLN;
|
|
ColorBit(inverseBit);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
WRITE('ABOUT TO DO CYAN from picture '); READLN;
|
|
ColorBit(cyanBit);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
WRITE('ABOUT TO DO MAGENTA from picture '); READLN;
|
|
ColorBit(magentaBit);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
WRITE('ABOUT TO DO YELLOW from picture '); READLN;
|
|
ColorBit(yellowBit);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
WRITE('ABOUT TO DO BLACK from picture'); READLN;
|
|
ColorBit(blackBit);
|
|
DrawPicture(myPicture,thePort^.portRect);
|
|
|
|
ColorBit(normalBit);
|
|
READLN;
|
|
|
|
PaintRect(thePort^.portRect);
|
|
REPEAT
|
|
FOR i:=0 to 15 DO
|
|
BEGIN
|
|
SetScale(numerArray[i],denomArray[i]);
|
|
DrawPicture(myPicture,dstRect);
|
|
IF MouseButton THEN GOTO 1;
|
|
END;
|
|
|
|
FOR i:=14 DOWNTO 1 DO
|
|
BEGIN
|
|
SetScale(numerArray[i],denomArray[i]);
|
|
DrawPicture(myPicture,dstRect);
|
|
IF MouseButton THEN GOTO 1;
|
|
END;
|
|
UNTIL FALSE;
|
|
|
|
1: ShowCursor;
|
|
|
|
SetRect(myPicture^^.picFrame,0,0,200,100);
|
|
|
|
REPEAT UNTIL NOT MouseButton;
|
|
REPEAT
|
|
REPEAT UNTIL MouseButton;
|
|
GetMouse(dstRect.topLeft);
|
|
REPEAT UNTIL NOT MouseButton;
|
|
GetMouse(dstRect.botRight);
|
|
ClipRect(thePort^.portRect);
|
|
PaintRect(thePort^.portRect);
|
|
DrawPicture(myPicture,dstRect);
|
|
IF MouseButton THEN EXIT(TestGraf);
|
|
UNTIL FALSE;
|
|
|
|
KillPicture(myPicture);
|
|
END.
|