JamPaint
Volume Number: | | 5
|
Issue Number: | | 7 |
|
Column Tag: | | Pascal Procedures
|
Related Info: AppleTalk Mgr
Build a Network Painting Program
By Edgar Circenis, Rod Magnuson, Lincoln, NE
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
[Edgar Circenis: Has programmed the Mac since 1984. Has been employed at Nordic Software and written software for both the Apple // and Macintosh. Graduate of the University of Nebraska--Lincoln with a B.S. C.S. Rod Magnuson: Has had 2 years programming the Macintosh. Founded MindVision software with Steve Kiene in early 1988. Co-author of MaxWrite, the first color word processor and MindVisions first offering.]
JamPaint: A Networked Paint Program
JamPaints Beginnings
Back in 1987, an AppleTalk network was installed in our workplace. We decided to write a simple program to allow communications between different nodes of this network. Our program, Transceive, used the NBP and LAP protocols to send text messages between nodes.
When we got the program working and realized how easy it was to use AppleTalk, we took Transceive one step further by rewriting it so that a user on one Mac could draw one the screen of several other Macs. To do this, we created a message format consisting of a message type identifier and data needed for the given type. We implemented two different types of messages: Click and Drag. A click message consisted of the Click message identifier and a Point. The drag message took a similar form. A Click message was sent when a user initially clicked on the screen. Then, Drag messages were sent every time that the mouse location changed, until the mouse button was released.
Transceive was rewritten to operate in either master or slave mode. In master mode, the click and drag messages were generated and broadcast over the network. In slave mode, the messages were interpreted and the results were drawn on the screen.
We relied entirely on the LAP protocol for our transmissions. This caused a problem because LAP has no facility for buffering incoming messages. Therefore, we experimented with using a VBLTask to periodically check the message buffer and put messages into our own buffer. This was a bad idea because the LAP protocol moves memory and VBLTasks cannot cause memory moves. Our program crashed periodically because of this. To solve our problem, we had to resort to polling the message buffer. This caused us to lose messages on occasion, but it was better than periodic crashes.
Finally, we were able to have up to eight (a practical limit) Macs hooked up and drawing on each others screens simultaneously. This was great fun for the staff at work, so we thought about the feasibility of extending Transceive into more of a paint program.
Transceive sat idle for months while we thought about what could and couldnt be done easily over a network. We wanted to keep message sizes small and had to have a system where lost messages wouldnt cause problems or crashes (with polling, messages will get lost). We thought about using the ATP protocol to avoid message loss, but decided that response time would be too slow for a real-time paint program. Eventually, we decided that LAP was still the best choice. Then, we decided to write JamPaint.
JamPaint is a simple, first come, first served Networked Paint program. To control users, we have an array of environment records. Each slot in this array is filled as unidentified users announce themselves (by sending an initial message) on the network. Again, we decided to limit the number of users to eight to reduce traffic on the network. JamPaint was written during a long weekend, but fixing bugs and adding new tools has kept us busy for 3-4 months. Initially, we had decided to make JamPaint a color paint program for the Mac II in addition to being networked. We wrote color code, but never spent much time trying to get offscreen pixmaps to work correctly. Hence, our screen updating was a mess on a Mac II. As soon as we get that code working, we will re-release JamPaint for color use on the Mac II.
The Way it was Programmed
JamPaint was written in MPW Pascal with little regard for proper programming technique. As a result, JamPaint variables are for the most part global variables. By using many globals, we eliminated the creation and initialization of large stack frames. Most of our procedure parameters are VAR parameters (to eliminate excessive stack frame initialization). By adopting this style, we were able to decrease memory usage and increase execution speed of our program.
JamPaint implements eight paint tools: paint brush, letters tool, eraser, rectangle, filled rectangle, oval, filled oval, and a spray-can tool. Our palette includes eight patterns which can be edited by double-clicking on them. JamPaint also includes a unique pen sizing tool which allows horizontal and vertical pen size to be set independently. We implemented the Pattern and Constraint keys found in most paint programs and tried to emulate the standard paint program user interface.
Once again, we used the type-and-data format for sending our messages across AppleTalk. To make JamPaint a fully networked paint program, we needed to create many new message types. For instance, occurrences such as selecting a new tool had to be transmitted over the network so that each node would know how to handle subsequent drag messages. A problem with this approach is that a tool selection message may be lost and drag message may be mis-interpreted. Fortunately, with only eight nodes, this doesnt happen often.
With JamPaint, we eliminated the master/slave modes used in Transceive and put all nodes in a combined master/slave mode. What this means is that every message incoming from a previously identified node will be executed. Also, every action performed locally will be broadcast.
To handle the transmission and execution of command messages, we implemented a simple command queue. Every incoming message is put into this queue, and periodically, the first message in the queue is executed. To save ourselves the trouble of duplicating this mechanism for local actions, and to simplify the testing of the incoming message routines, outgoing messages are broadcast and then put into the incoming message queue for execution locally. This way, all drawing gets handled by the same set of routines. Our approach not only cut down on code size, but simplified debugging and streamlined our message handling system.
How Things Get Drawn
JamPaint uses an offscreen bitmap to perform its updating and redraw. All drawing commands are duplicated -- once for the screen, and once for an offscreen bitmap. When an update is required, CopyBits is used to transfer the image back onto the screen. This approach was made necessary when we decided that our window wouldnt always be the front window (because of DAs, dialogs, etc.).
The Users on the Network
JamPaint treats each user as a paint environment. When a user first starts using JamPaint, a message corresponding to their first action is broadcast over the network. Any nodes that still have room in their environment tables (remember, only eight entries) will notice that this message comes from an unidentified node. They will then request that the sending node transmit its environment. The same happens in the other direction. The new node will not recognize the already operating nodes and will fill its own environment tables the same way.
The following data structure is used to keep track of a user environment:
{1}
UserTableRec = record
id:integer;{ AppleTalk ID number }
time:longint; { time elapsed since last message sent }
theTool:integer;{ current pain tool }
x,y:integer; { last pen coordinate }
theMode:boolean;{ line or dot mode }
thePat:pattern; { penPat }
theClr:RGBColor;{ color for Mac II }
hSize,vSize:integer;{ pen size }
theFnum:integer;{ font number }
theFsize:integer; { font size }
theFstyle:style;{ font style }
splatRad:integer; { splatter radius for airbrush }
splatSpeed:integer; { splatter speed for airbrush }
end;
id : The AppleTalk node id of the user. This is needed to send our messages through the LAP protocol calls.
time : The TickCount value of the last time a message from the user was executed. This is used to eliminate dead users from the network.
theTool : is the current tool for the user.
x, y : The current pen position of the user.
theMode : The current mode of the user. JamPaint supports two drawing modes: line and dot. In line mode, drag packets connect the current x,y position with a line to the previous position. In Dot mode, no connection is made.
splatRad : The airbrush radius; double clicking on the spray-can tool will bring up a dialog that allows the airbrush radius to be resized.
splatSpeed : The airbrush speed, or how many particles get sprayed each time a drag message is received; this can also be changed by double-clicking the spray-can tool.
Packet Types
The following is the variant data structure used for the different message types in JamPaint:
{2}
MSGType=(paintMode,alpha,settool,eraseall,setpat,setcolor,setpen, setfont,
setpos,drag,rectpck,setSplat,rqinfo,sendinfo);
LAPMsg = record
size :packed array [0..1] of byte;
theType:MSGType;
id:byte;
case MSGType of
paintMode:(mode:boolean);
alpha:(ch:char);{ type char in current font,size,style ,location }
settool:(tool:integer); { select a tool }
setpat:(pat:pattern); { select a pattern }
setcolor:(clr:RGBColor); { select a color }
setpen:(px,py:integer); { set pen size to px,py }
setfont:(fnum:integer; { select font characteristics }
fsize:integer;
fstyl:style);
setpos:(mx,my:integer); { set current position to mx,my }
drag:(cx,cy:integer);{ mouse dragged from mx,my to cx,cy }
setSplat:(sRad:integer; { resize splatter tool }
sSpeed:integer);
rectpck:(rct:rect;{ rectangle for TRect..TFOval }
optDown:boolean);
sendinfo:(info:UserTableRec);{ user info }
end;
All paint functions are executed by transmitting one of these message data structures to the users on the network.
Implementing Tools That Require Waiting
Implementing the oval and rectangle drawing tools was more difficult than implementing the other tools. This is due to the fact that these objects can be enlarged and shrunken before actually being placed into a document. With messages coming in from other machines, we had to address the problem of what to do while the user was sizing an object. Also, we had to worry about how resizing was to be done on a remote machine.
We decided that it would be a waste of code and time to resize objects on a remote screen. After all, the finished object was what we were after. This left only the problem of how to handle resizing locally while executing incoming messages. Our solution was to do all resizing on the screen only. We would leave the offscreen bitmap alone until the object was complete. All incoming messages get executed on the offscreen bitmap and updated to the screen. Then, when the sized object is complete, a message is transmitted to draw it both locally and elsewhere. This way, we reduce AppleTalk traffic, eliminate the problem of missed messages, and avoid over-writing of previous drawing.
Drag Packets
Whenever a user is holding down the mouse, drag messages are transmitted (unless the rectangle or oval tools are selected). Drag messages contain only the new location of the mouse. When a Drag message is received, it is sent to one of the drawing routines depending on the current tool in the environment record for the user in question. This local interpretation of commands was chosen because it results in smaller AppleTalk packets, leading to better throughput.
JamPaints Future
Is there a future for JamPaint? We think so. Anyone who has played (yes, its more like playing than painting) with JamPaint has to admit that it was fun. We plan to enhance JamPaint by making it into a real paint program. Planned enhancements include:
Color
Separate palette and tool windows with more patterns and tools.
A full page (or possibly oversize) drawing surface.
Selection tools.
Special effects (fades, contrast enhancement, smoothing, etc.).
Paint channels and privacy mode.
Object-oriented drawing.
Enhance compatibility with existing paint programs.
Memos.
We would like to think that JamPaint is a step into the future. JamPaint is a new kind of tool which not only allows many people to see the same piece of work, but to also modify it. We are trying to bring real connectivity to the Mac by creating multi-user software.
We ask that you do not change JamPaint and distribute it. It has been copy righted. To maintain some sort of order, and minimize confusion, MindVision Software will gladly accept suggestions for improvements to this program. If you would like to add something to JamPaint, let us know what youre doing and maybe we can work together. Our About Window has room for plenty of names; just dont expect to become rich.
After Thought
We suggest that you run JamPaint on System 4.1 or 4.2 because JamPaint is very slow running under System Software 6.0. We do not know why this is. We havent had time to look into it yet.
We have also noted that Apple has implemented something similar to JamPaint in HyperCard with their XCMD set that allows access to NBP and LAP AppleTalk protocols from script.
Listing: MakeFile.p
##### JamPaint MakeFile #####
Pascal =Pascal
POptions =-s
.p.o .p
Pascal -k {PLibraries} {default}.p
JamPaint JamPaint.r JamPaint.code
Rez {RIncludes}Types.r JamPaint.r -o JamPaint -c JPNT
SetFile -a B -d . JamPaint
JamPaint.code JamPaint.p.o
Link JamPaint.p.o
{Libraries}Interface.o
{PLibraries}Paslib.o
{Libraries}Runtime.o
-o JamPaint.code
Continued in next frame
|
|
Volume Number: | | 5
|
Issue Number: | | 7 |
|
Column Tag: | | Pascal Procedures
|
Related Info: AppleTalk Mgr
Build a Network Painting Program (Code)
Listing: JamPaint.p
Program JamPaint;
{*************************************************
JamPaint -- the Network Paint Application
*************************************************
Copyright 1988 by Edgar Circenis and Rod Magnuson
All Rights Reserved
*************************************************
Started: 12/26/87 Revision: 5/21/88
*************************************************
Problem areas:
- Do we need to worry about nets as well as nodes?
- How big should PQ be?
- VBLTasks cannot move memory.
- Change xEnqueue and xDequeue to access PQ directly.
- What causes initial LAPWrite error @70 (err = -95)???
- NOTE: if we end up using polling, a queue will be unnecessary.
- use VAR parameters where it will speed things up.
*************************************************}
USES
{$LOAD MacDump}
Memtypes,Quickdraw,OSIntf,ToolIntf,PackIntf,PickerIntf,
Script,
{$LOAD AppleTalkDump}
AppleTalk,
{$LOAD MacPrintDump}
PrintTraps;
CONST
lastMenu = 7;
maxUsers = 8; { User Table size }
OurType= 39; { a random LAP protocol type }
listSize = 550; { incoming packet queue size }
VBLcnt = 2;{ myTask.vblCount }
connect= false;
spray = true;
idleTime = 60*60*5; { five minute idle time }
eraseCursor = 128;
splatCursor = 8088; { splatter cursor ID }
{ ---- TOOLS ---- }
Tnone = 0;{ no tool, or special tool }
Tspray = 1;{ not really a tool! }
TLetters = 2; { letter tool }
Tbrush = 3;{ paint brush }
Terase = 4;{ eraser }
TRect = 5;{ Rectangle }
TFrect = 6;{ Filled Rectangle }
TOval = 7;{ Oval }
TFOval = 8;{ Filled Oval }
TSplatter= 9; { Splatter Tool }
TDisk = 10; { Disk Access }
Tpat = 11; { not a tool }
Tcolor = 12; { not a tool }
{ ---- DEFAULTS ---- }
dSize = 12;
dStyle = [];
dPen = 1;{ 1 x 1 pen }
dColor = 1;{ black }
dTool = Tbrush;
dMode = connect;
dsplatterCount = 30;{ * default spatter speed * }
dsplatRad= 20; { * default splatter radius * }
{ **** make a decision about this and delete it **** }
polling = true;
appleMenu= 1;
fileMenu = 2;
fontMenu = 3;
sizeMenu = 4;
styleMenu= 5;
effectsMenu= 6;
editMenu = 7;
TYPE
UserTableRec = record
id:integer;{ appleTalk id }
time :longint;{ idle time }
theTool:integer;{ current tool }
x,y :integer;{ mouse coordinates }
theMode:boolean;{ paint mode }
thePat :pattern;{ current pattern }
theClr :RGBColor; { current color }
hSize,vSize:integer;{ penSize }
theFnum:integer;{ font number }
theFsize :integer;{ font size }
theFstyle:style;{ font style }
splatRad :integer;{ splatters radius }
splatSpeed :integer;{ splatters speed }
end;
MSGType = (paintMode,alpha,settool,eraseall,setpat ,setcolor,setpen,setfont,setpos,drag,rectpck,setSplat,rqinfo,sendinfo);
LAPMsg = record
size :packed array [0..1] of byte;{packet length}
theType:MSGType;{ message type }
id:byte; { node id }
case MSGType of
paintMode: (mode:boolean);
{ select paint mode type: connect, spray }
alpha: (ch :char);
{ type char in current font, size, style, location }
settool: (tool :integer); { select a tool }
setpat:(pat:pattern); { select a pattern }
setcolor:(clr :RGBColor);{ select a color }
setpen:(px,py:integer);{set pen size to px,py }
setfont: (fnum :integer;{ font characteristics }
fsize:integer;
fstyl:style);
setpos:(mx,my:integer);{set position to mx,my}
drag: (cx,cy:integer);
{ mouse dragged from mx,my to cx,cy }
setSplat:(sRad:integer; { resize splatter tool }
sSpeed:integer);
rectpck: (rct :rect;{rectangle for TRect..TFOval}
optDown:boolean);
sendinfo:(info :UserTableRec);{ user info }
end;
LAPMsgPtr = ^LAPMsg;
PacketList = Packed array [0..listSize-1] of LAPMsg;
PacketQueue = record
head :integer;
tail :integer;
queue :PacketList;
end;
PacketQueuePtr = ^PacketQueue;
CArry = Array [1..8] of RGBColor;
CPtr = ^CArry;
CHandle= ^CPtr;
BitMapPtr= ^BitMap;
VAR
{ A NOTE ABOUT GLOBALS AND SUCH:
Everyone is taught that using global variables is a sin. We do not agree.
By using many globals and declaring parameters in parameter lists to
be VAR parameters (even when not needed), we increase the speed of our
code by reducing stack frame size and the creation of local copies of
variables.}
myEvent:EventRecord;
theItem,theMenu,refnum :integer;
theChar:Char;
code :integer;
tempWindow,myWindow :WindowPtr;
doneflag :boolean;
PrDebug:boolean;
mods :longint;
mymenus:array [1..lastmenu] of MenuHandle;
FileMenuPresent :boolean;
err :integer;
dlg :DialogPtr;
itype :integer;
item :handle;
box :rect;
itemHit:integer;
myTask :VBLTask;
UT:array [0..maxUsers] of UserTableRec;
PQ:PacketQueue;
myNode,myNet :integer;
LAPrh,LAPwh:ABRecHandle;
LAPrbuf,LAPwbuf :LAPMsg;
DrawWindow :WindowPtr;
drect,prect:rect;
jamPic,palette :picHandle;
ToolRects:array[1..20] of Rect;
curPatRect :rect;
hSizeRect,vSizeRect :rect;
PatternsUp :Boolean;
thePatterns:array [1..8] of pattern;
theColors:CArry;
curPat,curColor :integer;
theFontidx :integer;
theSizeidx :integer;
clickTime:longint;
lastTool :integer;
theECurs,theCurs:cursor;
arrowCurs,updateCurs:boolean;
bmap,Wbits :bitmap;
oldRgn,oldClip :RgnHandle;
changed,saved :boolean;
fVref :integer;
MultiFinderRunning:boolean;
ColorQDrawImplm :boolean;
MacII,PixDraw :boolean;
myCGrafPtr :CGrafPtr;
myCGrafPort:CGrafPort;
ourCMHandle:CTabHandle;
offpix,Wpix:PixMapHandle;
theHand,theSizer:CursHandle;
theSprayer,thePlacer:CursHandle;
hPrint :THPrint;
Procedure SendLAP(who:byte); Forward;
Procedure CheckRead;Forward;
Procedure DrawContents; Forward;
Procedure Debug(s:str255);
begin
if PrDebug then
begin
PrCtlCall(iPrIOCtl,ord(@s)+1,length(s),0);
PrCtlCall(iPrDevCtl,$0003FFFF,0,0);
end;
end;
Function Str(i:longInt):str255;
{ These two functions are invaluable }
begin
NumToString(i,Str);
end;
Function Val(s:str255):longint;
begin
StringToNum(s,Val);
end;
function MyGetNextEvent(evtMask:Integer;VAR Evt:EventRecord):Boolean;
{ * This allows us to be more MultiFinder compatible * }
begin
If MultiFinderRunning then
MyGetNextEvent:=WaitNextEvent(evtMask,Evt,15,Nil)
else
begin
SystemTask;
MyGetNextEvent:=GetNextEvent(evtMask,Evt);
end;
end;
Procedure MenuString(s:str255); {debugging simple stuff }
var
dMenu :MenuHandle;
begin
s := Concat(s, <click>);
DMenu := NewMenu(999,s);
InsertMenu(DMenu,0);
DrawMenuBar;
sysBeep(1);
repeat Until MyGetNextEvent(mdownMask+keyDownMask+AutoKeyMask,myEvent);
DeleteMenu(999);
DisposeMenu(DMenu);
DrawMenuBar;
end;
Function idleFilter(item:Integer;theDlg:DialogPtr):Integer;
begin
SetUpA5;
idleFilter:=item;
CheckRead;
RestoreA5;
end;
procedure HiliteButton(theDialog:DialogPtr);
begin
SetPort(theDialog);
GetDItem(theDialog,ok,iType,iTem,Box);
InsetRect(Box,-4,-4);
PenSize(3,3);
FrameRoundRect(box,15,16);
PenNormal;
end;
Procedure DoErr(i:integer);
begin
if err<>0 then
begin
if prDebug then
Debug(concat(*** ,str(i),: error = ,str(err)))
else
menuString(concat(str(i),: error = ,str(err)));
end;
end;
Procedure RsrcErr;
begin
if ResError<>0 then
begin
if PrDebug then
Debug(concat(*** RsrcErr=,str(ResError)))
else
menuString(concat(RsrcErr=,str(ResError)));
end;
end;
Procedure SetUpMenus;
var
i :integer;
s,fName:str255;
begin
InitMenus;
FileMenuPresent:=false;
for i := 1 to lastmenu do
MyMenus[i] := GetMenu(254+i);
for i := 1 to lastmenu-1 do
InsertMenu(myMenus[i],0);
AddResMenu(MyMenus[appleMenu],DRVR);
AddResMenu(MyMenus[fontMenu],FONT);
GetFontName(applFont,fName);
for i := 1 to countMItems(mymenus[fontMenu]) do
begin
GetItem(mymenus[fontMenu],i,s);
if s=fName then
begin
CheckItem(mymenus[fontMenu],i,true);
theFontidx := i;
leave;
end;
end;
for i:=1 to 9 do
begin
GetItem(myMenus[sizeMenu],i,s);
if RealFont(theFontidx,Val(s))
then
SetItemStyle(myMenus[sizeMenu],i,[Outline])
else
SetItemStyle(myMenus[sizeMenu],i,[]);
end;
DrawMenuBar;
end;
Procedure xEnqueue(var msg:LAPMsg); { add queue element }
begin
Debug(xEnqueue);
with PQ do
if (tail+1) mod listSize = head then
begin
sysbeep(1);{ oops, queue full! }
Debug(Queue Full);
end
else
begin
queue[tail] := msg;
tail := (tail+1) mod listSize;
Debug(concat( head=,str(head),, tail=,str(tail)));
end;
end;
Function xDequeue(var msg:LAPMsg):boolean; { remove first queue element
}
begin
with PQ do
if tail=head then
xDequeue := false
else
begin
Debug(xDequeue: dequeued);
msg := queue[head];
head := (head+1) mod listsize;
xDequeue := true;
Debug(concat( head=,str(head),, tail=,str(tail)));
end;
end;
procedure DoPageSetUp;
var
temphPrint : THPrint;
err : OSErr;
begin
PrOpen;
If PrError=noErr then
begin
temphPrint:=hPrint;
err:=HandToHand(handle(temphPrint));
Repeat
if PrStlDialog(temphPrint) then
begin
DisposHandle(handle(hPrint));
If MemError<>NoErr then
SysBeep(1);
hPrint:=temphPrint;
err:=HandToHand(handle(hPrint));
if err<>NoErr then
SysBeep(1);
end;
Until not PrValidate(hPrint);
end;
PrClose;
DisposHandle(handle(temphPrint));
end;
Function FindUser(id:integer):integer;{ find UT entry }
{ find user in UT. If not in UT, return -1 and send <rqinfo> packet
to user if table not yet full. If data is not valid, returns -(index+1).
}
var
i :integer;
begin
Debug(FindUser);
for i := 0 to maxUsers do{ CASE 1: look for user }
if UT[i].id=id then
begin
FindUser := i; { valid user found }
Debug( user found);
exit(FindUser);
end;
Debug( user not found);
for i := 1 to maxUsers do{CASE 2:look for empty slot}
if UT[i].id<0 then
begin
UT[i].id := id;
LAPwbuf.theType := rqinfo;
SendLAP(id);
FindUser := -1; { user not valid (yet) }
exit(FindUser);
end;
for i := 1 to maxUsers do {CASE 3:look for idle user}
if tickCount-UT[i].time>idleTime then
begin
UT[i].id := id;
LAPwbuf.theType := rqinfo;
SendLAP(id);
FindUser := -1; { user not valid (yet) }
exit(FindUser);
end;
end;
Procedure SetUserState(j:integer);{ set previous state }
begin
Debug(SetUserState);
with UT[j] do
begin
MoveTo(x,y);
PenPat(thePat);
if MacII then
RGBForeColor(theClr);
PenSize(hSize,vSize);
TextFont(theFnum);
TextSize(theFsize);
TextFace(theFstyle);
end;
end;
Procedure OffBits;{ set offscreen bitmap }
begin
if MacII then
begin
if PixDraw then
begin
SetPort(GrafPtr(myCGrafPtr));
end;
end
else
begin
oldRgn:=NewRgn;
CopyRgn(DrawWindow^.visRgn,oldRgn);
RectRgn(DrawWindow^.visRgn,bmap.bounds);
Wbits:=DrawWindow^.portbits;
SetPortBits(bmap);
end;
end;
Procedure OnBits; { set onscreen bitmap }
begin
if MacII
then
begin
if PixDraw then
begin
SetPort(DrawWindow);
end;
end
else
begin
CopyRgn(oldRgn,DrawWindow^.visRgn);
DisposeRgn(oldRgn);
SetPort(DrawWindow);
SetPortBits(Wbits);
end;
end;
Procedure DoSplatter(user:integer);
var
r :rect;
i,xx,yy:integer;
begin
ClipRect(drect);
with UT[user] do
for i := 1 to splatSpeed do
begin
repeat
xx := random mod SplatRad;
yy := random mod SplatRad;
until xx*xx+yy*yy <= SplatRad*SplatRad;
xx := xx + x;
yy := yy + y;
SetRect(r,xx,yy,xx+hSize,yy+vSize);
PaintRect(r);
OffBits;
PaintRect(r);
OnBits;
end;
ClipRect(drawWindow^.portRect);
end;
Procedure DoRect(utnum:integer;r:rect;optDown:boolean);
{ handle rect packets }
begin
Debug(DoRect);
with UT[utnum] do
case theTool of
TRect: begin
if not optDown then
PenPat(black);
FrameRect(r);
OffBits;
FrameRect(r);
OnBits;
end;
TFRect:begin
PaintRect(r);
OffBits;
PaintRect(r);
OnBits;
if not optDown then
begin
PenPat(black);
FrameRect(r);
OffBits;
FrameRect(r);
OnBits;
end;
end;
TOval: begin
if not optDown then
PenPat(black);
FrameOval(r);
OffBits;
FrameOval(r);
OnBits;
end;
TFOval:begin
PaintOval(r);
OffBits;
PaintOval(r);
OnBits;
if not optDown then
begin
PenPat(black);
FrameOval(r);
OffBits;
FrameOval(r);
OnBits;
end;
end;
end;
end;
Procedure DoDrag(utnum,dx,dy:integer);{drag packets}
var
pt:point;
r :rect;
begin
Debug(DoDrag);
with UT[utnum] do
case theTool of
Tbrush:begin
if theMode=connect then
begin
GetPen(pt);
LineTo(dx,dy);
OffBits;
MoveTo(pt.h,pt.v);
LineTo(dx,dy);
OnBits;
end
else
begin
MoveTo(dx,dy);
Line(0,0);
OffBits;
MoveTo(dx,dy);
Line(0,0);
OnBits;
end;
x := dx;
y := dy;
end;
Terase:begin
penPat(white);
if theMode=connect then
begin
GetPen(pt);
LineTo(dx,dy);
OffBits;
MoveTo(pt.h,pt.v);
LineTo(dx,dy);
OnBits;
end
else
begin
MoveTo(dx,dy);
Line(0,0);
OffBits;
MoveTo(dx,dy);
Line(0,0);
OnBits;
end;
x := dx;
y := dy;
end;
TSplatter: begin
x := dx;
y := dy;
DoSplatter(utnum);
end;
end;
end;
Procedure SendMyInfo(id:integer); { send UT to node <id> }
begin
Debug(SendMyInfo);
with LAPwbuf do
begin
theType := sendinfo;
info := UT[0];
end;
SendLAP(id);
end;
Procedure DebugLAPType(t:MSGType);
begin
case t of
paintMode: Debug( paintMode);
alpha: Debug( alpha);
settool: Debug( settool);
eraseall:Debug( eraseall);
setpat:Debug( setpat);
setcolor:Debug( setcolor);
setpen:Debug( setpen);
setfont: Debug( setfont);
setpos:Debug( setpos);
drag: Debug( drag);
rectpck: Debug( rect);
rqinfo:Debug( rqinfo);
sendinfo:Debug( sendinfo);
end;
end;
Procedure ExecMessage(var msg:LAPMsg);{ handle a LAP message }
var
j :integer;
pt:point;
savePort :GrafPtr;
begin
Debug(ExecMessage);
changed := true;
with msg do
if theType=rqInfo then { handle rqInfo requests }
begin
SendMyInfo(id);
DebugLAPType(theType);
end
else { handle graphics commands }
begin
GetPort(savePort);
SetPort(DrawWindow);
j := FindUser(id);{ get index into user table }
if j>=0 then
begin
SetUserState(j);{ set users port state }
with UT[j] do
begin
DebugLAPType(theType);
case theType of
paintMode: theMode := mode;
alpha: begin
GetPen(pt);
DrawChar(ch);
OffBits;
MoveTo(pt.h,pt.v);
DrawChar(ch);
OnBits;
GetPen(pt);
x := pt.h;
y := pt.v;
end;
eraseall: begin
eraseRect(drect);
OffBits;
eraseRect(drect);
OnBits;
end;
settool: theTool := tool;
setpat:thePat := pat;
setcolor:theClr := clr;
setpen:begin
hSize := px;
vSize := py;
end;
setfont: begin
theFnum := fnum;
theFsize := fsize;
theFstyle := fstyl;
end;
setpos:begin
x := mx;
y := my;
end;
drag: DoDrag(j,cx,cy);
rectpck: DoRect(j,rct,optDown);
setSplat:begin
splatRad := sRad;
splatSpeed := sSpeed;
end;
sendinfo:begin
UT[j] := info;
Debug( sendInfo received);
end;
end;
time := tickCount;{ user is active }
end;
end
else
Debug( msg not executed);
SetPort(savePort);
end;
end;
Procedure CheckQueue;{execute packet from incoming queue}
var
msg :LAPMsg;
begin
if polling then
CheckRead;
if xDequeue(msg) then { incoming queue }
ExecMessage(msg);
end;
Procedure SendLAP(who:byte); {send LAP Packt to node <id>}
var
sz:longint;
begin
Debug(SendLAP);
DebugLAPType(LAPwbuf.theType);
{%%%%%%%%%% THIS NEEDS TO BE RECALCULATED! %%%%%%%%%%%}
case LAPwbuf.theType of
paintMode,alpha,settool: sz := 2;
eraseall:sz := 0;
setpat:sz := sizeof(pattern);
setcolor:sz := sizeof(RGBColor);
setfont: sz := sizeof(style) + 4;
setpos,setpen,drag: sz := 4;
rectpck: sz := sizeof(rect)+2;
sendinfo:sz := sizeof(UserTableRec);
setSplat:sz := 4;
end;
sz := sizeof(MSGType)+4+sz;{ LAP packet size }
sz := sizeof(LAPMsg); { <-- DEBUGGING ONLY }
with LAPwbuf do { set up LAP packet size, sender id }
begin
id := myNode;
size[0] := sz div 256;
size[1] := sz mod 256;
end;
with LAPwh^^ do
begin
lapAddress.lapProtType := OurType; {protocol type}
lapAddress.dstNodeID := who; { destination node }
lapReqCount := sz;{ packet size }
lapDataPtr := @LAPwbuf; { packet data pointer }
end;
err := LAPWrite(LAPwh,false);{ send LAP packet }
DoErr(70);
if LAPwbuf.theType < rqInfo then
{ dont want to execute rqInfo or sendInfo locally }
ExecMessage(LAPwbuf); { execute message locally }
end;
Procedure CheckRead;
var
destnode :integer;
begin
SetUpA5;
err := LAPrh^^.abResult;
if err=0 then
begin
Debug(CheckRead: msg rcvd);
DebugLAPType(LAPrbuf.theType);
destNode := LAPrh^^.lapAddress.dstNodeID;
if (destNode=255) or (destNode=myNode) then
xEnqueue(LAPrbuf);
end;
if err<>1 then
begin
with LAPrh^^ do
begin
lapAddress.lapProtType := OurType;
lapReqCount := Sizeof(LAPMsg);
lapDataPtr := @LAPrbuf;
end;
err := LAPRead(LAPrh,true);
DoErr(5000);
end;
myTask.vblCount := VBLCnt;
RestoreA5;
end;
Procedure SetUpRead;
begin
with LAPrh^^ do
begin
lapAddress.lapProtType := OurType;
lapReqCount := Sizeof(LAPMsg);
lapDataPtr := @LAPrbuf;
end;
err := LAPRead(LAPrh,true);
DoErr(71);
if not polling then
begin
with myTask do
begin
qType := ord(vType);
vblAddr := @CheckRead;
vblCount := VBLCnt;
vblPhase := VBLCnt div 2 + 1;
end;
err := VInstall(@myTask);
DoErr(500);
end;
end;
Procedure DisplayPatterns;
var
i :integer;
begin
for i := 1 to 8 do
FillRect(toolRects[i+12],thePatterns[i]);
FillRect(curPatRect,thePatterns[curPat]);
end;
Procedure DisplayColors;
var
i :integer;
begin
PenNormal;
for i := 1 to 8 do
begin
RGBForeColor(theColors[i]);
PaintRect(toolRects[i+12]);
end;
RGBForeColor(theColors[curColor]);
PaintRect(curPatRect);
end;
Procedure DrawPalette;
var
r :rect;
begin
SetPort(DrawWindow);
DrawPicture(palette,prect);
with UT[0] do
begin
InvertRect(toolRects[theTool]);
if not theMode then
with toolRects[theTool] do
begin
PenMode(PatXOR);
PenPat(ltgray);
PaintRect(toolRects[Tspray]);
PenNormal;
end;
end;
PenMode(PatXOR);
PenPat(ltgray);
if PatternsUp then
begin
PaintRect(toolRects[Tcolor]);
PenNormal;
DisplayPatterns;
end
else
begin
PaintRect(toolRects[Tpat]);
PenNormal;
DisplayColors;
end;
with vSizeRect,UT[0] do
SetRect(r,left,top+(vSize-1)*2,right,top+vSize*2);
InvertRect(r);
with hSizeRect,UT[0] do
SetRect(r,left,top+(hSize-1)*2,right,top+hSize*2);
InvertRect(r);
{draw current tools, modes, pattern/color, pensize}
end;
Procedure OpenBitMap(r:rect);{ create offscreen bitmap }
var
pb:Bitmap;
xx,yy,sn :Longint;
i :Integer;
saveGDevice:GDHandle;
maxGDevice :GDHandle;
theDepth :Integer;
offRowBytes:Longint;
sizeOfOff:LongInt;
begin
if MacII then
begin
if PixDraw then
begin
{ * Pix Map Makin * }
saveGDevice:=GetGDevice;
maxGDevice:=GetMaxDevice(screenBits.Bounds);
SetGDevice(maxGDevice);
myCGrafPtr:=@myCGrafPort;
OpenCPort(myCGrafPtr);
theDepth:=myCGrafPtr^.portPixMap^^.pixelSize;
with r do
begin
offRowBytes:=((((theDepth*(right-left))+15))DIV 16)*2;
sizeOfOff:=LongInt(bottom-top)*offRowBytes;
end;
with myCGrafPtr^.portPixMap^^ do
begin
DisposPtr(baseAddr);
baseAddr:=NewPtr(sizeOfOff);
rowBytes:=offRowBytes+$8000;
bounds:=r;
end;
ourCMHandle:=maxGDevice^^.gdpMap^^.pmTable;
err:=HandToHand(handle(ourCMHandle));
If Err<>NoErr then
SysBeep(1);
{$R-}
with ourCMHandle^^ do
begin
for i:=0 to ctSize do
ctTable[i].value:=i;
transIndex:=BAND(transIndex,$7FFF);
end;
{$R+}
myCGrafPtr^.portPixMap^^.pmTable:=ourCMHandle;
bmap:=BitMapPtr(myCGrafPtr^.portPixMap^)^;
Wbits:=BitMapPtr(CGrafPtr(DrawWindow)^.portPixMap^)^;
SetPort(GrafPtr(myCGrafPtr));
EraseRect(thePort^.portRect);
SetPort(DrawWindow);
SetGDevice(saveGDevice);
end;
end
else
begin
with r do
begin
xx := right-left;
yy := bottom-top;
end;
sn := ((xx+15) div 16)*2*yy;
with bmap do
begin
bounds := r;
rowBytes := ((xx+15) div 16)*2;
BaseAddr := NewPtr(sn);
end;
pb := DrawWindow^.portbits;
SetPortBits(bmap);
ClipRect(r);
RectRgn(DrawWindow^.visRgn,r);
EraseRect(r);
SetPortBits(pb);
ClipRect(DrawWindow^.portRect);
RectRgn(DrawWindow^.visRgn,DrawWindow^.portRect);
Wbits:=DrawWindow^.portbits;
end;
end;
Procedure OpenDrawWindow;{ initialize drawing window }
var
r :rect;
begin
if MacII then
DrawWindow := GetNewCWindow(129,nil,pointer(-1))
else
DrawWindow := GetNewWindow(129,nil,pointer(-1));
SetPort(DrawWindow);
dRect := DrawWindow^.portrect; { drawing area }
drect.left := dRect.left + 46; {make room for palette}
setRect(r,0,0,576,720);
OpenBitMap(r);
prect := palette^^.picFrame;
OffsetRect(prect,-prect.left,-prect.top);
{ palette bounds }
DrawPalette;
end;
Procedure ChangeTool(NewTool:Integer);{ set a new tool }
begin
with LAPwBuf do
begin
theType := setTool;
tool := NewTool;
end;
SendLap(255);
end;
Function DoSizeTool(pt:point;r:rect;cur:integer):integer;
var
x :integer;
r2:rect;
begin
repeat
x := (pt.v-r.top) div 2;
if x<1 then
x := 1
else if x>16 then
x := 16;
if x<>cur then
begin
SetRect(r2,r.left,r.top+(cur-1)*2,r.right,r.top+cur*2);
InvertRect(r2);
cur := x;
SetRect(r2,r.left,r.top+(cur-1)*2,r.right,r.top+cur*2);
InvertRect(r2);
end;
GetMouse(pt);
until MyGetNextEvent(mUpMask,myEvent);
DoSizeTool := cur;
end;
procedure PatternEditor(VAR myPat:Pattern);
var
dlg : DialogPtr;
aPat : Pattern;
myEvent: EventRecord;
done : Boolean;
draw : Boolean;
dh,dv : Integer;
patRect: Rect;
patEdit: Rect;
tRect : Rect;
savePort : GrafPtr;
function GetBitRect(index:Integer):Rect;
begin
dh:=(index mod 8)*10;
dv:=(index Div 8)*10;
with tRect do
begin
left:=patEdit.left+dh;
right:=left+10;
top:=patEdit.top+dv;
bottom:=top+10;
end;
InsetRect(tRect,1,1);
GetBitRect:=tRect;
end;
procedure InitPatBits;
var
i : Integer;
begin
for i:=0 to 63 do
if BitTst(@aPat,i)
then
FillRect(GetBitRect(i),Black)
else
FillRect(GetBitRect(i),White);
end;
function GetBitPos(pt:point):integer;
begin
dh:=pt.h-patEdit.left;
dh:=dh div 10;
dv:=pt.v-patEdit.top;
dv:=dv div 10;
GetBitPos:=dv*8+dh;
end;
procedure EditPatClick(pt:point;firstOne:Boolean);
var
index : integer;
begin
index:=GetBitPos(pt);
if firstOne then
begin
if BitTst(@aPat,index)
then
draw:=false
else
draw:=true;
end;
if draw
then
begin
FillRect(GetBitRect(index),Black);
BitSet(@aPat,index);
end
else
begin
FillRect(GetBitRect(index),White);
BitClr(@aPat,index);
end;
FillRect(patRect,aPat);
end;
begin
GetPort(savePort);
aPat:=myPat;
dlg:=GetNewDialog(1000,Nil,Pointer(-1));
HiliteButton(dlg);
done:=false;
GetDItem(dlg,3,iType,iTem,patEdit);
tRect:=patEdit;
InsetRect(tRect,-1,-1);
FrameRect(tRect);
GetDItem(dlg,4,iType,iTem,patRect);
tRect:=patRect;
InsetRect(tRect,-1,-1);
FrameRect(tRect);
FillRect(patRect,aPat);
InitPatBits;
Repeat
CheckQueue;
If MyGetNextEvent(everyEvent,myEvent) then
If isDialogEvent(myEvent) then
if DialogSelect(myEvent,myWindow,itemHit) then
Case itemHit of
Ok,Cancel:Done:=True;
3:
with myEvent do
begin
GlobalToLocal(where);
EditPatClick(where,true);
Repeat
GetMouse(where);
if PtInRect(where,patEdit) then
EditPatClick(where,false);
CheckQueue;
Until Not StillDown;
end;
end;{Case}
Until done;
if ItemHit=Ok then
myPat:=aPat;
DisposDialog(dlg);
SetPort(savePort);
end;
Procedure SetupCursor;
var
savebits,bm:bitmap;
r :rect;
begin
with UT[0] do
case theTool of
Tbrush:if MacII then
begin
SetCursor(arrow); { * For now, manipulate color cursor * }
end
else
begin
SetRect(bm.bounds,0,0,16,16);
bm.baseAddr := @theCurs;
bm.rowBytes := 2;
saveBits := drawWindow^.portbits;
SetPortBits(bm);
EraseRect(bm.bounds);
with UT[0] do
SetRect(r,0,0,hSize,vSize);
FillRect(r,black);
SetPortBits(saveBits);
SetCursor(theCurs);
end;
TSplatter: SetCursor(theSprayer^^);
Tletters:SetCursor(GetCursor(iBeamCursor)^^);
Terase:if MacII then
begin
SetCursor(arrow); { * For now, manipulate color cursor *}
end
else
begin
SetRect(bm.bounds,0,0,16,16);
bm.baseAddr := @theECurs;
bm.rowBytes := 2;
saveBits := drawWindow^.portbits;
SetPortBits(bm);
FillRect(bm.bounds,white);
with UT[0] do
SetRect(r,0,0,hSize,vSize);
FrameRect(r);
bm.baseAddr := @theECurs.mask;
EraseRect(bm.bounds);
FillRect(r,black);
SetPortBits(saveBits);
SetCursor(theECurs);
end;
Trect..Tfoval: SetCursor(GetCursor(crossCursor)^^);
end;
updateCurs := false;
end;
Procedure FixCursor;{ handle cursor updating }
var
pt:point;
begin
If windowPeek(FrontWindow)^.windowKind>-1 then
begin
GetMouse(pt);
if (PtInRect(pt,dRect) and arrowCurs) or updateCurs then
begin
SetupCursor;
arrowCurs := false;
end
else if (not PtInRect(pt,dRect)) and (not arrowCurs) then
begin
SetCursor(arrow);
arrowCurs := true;
end;
end;
end;
Procedure SavePic(saveas:boolean);{ save file }
var
where :point;
reply :SFReply;
err :integer;
ar,dr :packed array [0..75] of byte;
n,l :longint;
i,j,ref:integer;
r,rr :rect;
bm:bitmap;
srcPtr :ptr;
dstPtr :ptr;
h :handle;
s :str255;
procedure ChkErr;
begin
if err <> 0 then
DoErr(err);
end;
begin
if not saved then
saveas := true;
if saveas then
begin
SetPt(where,50,50);
GetWTitle(drawWindow,s);
SFPutFile(where,Save document as:,s,@idleFilter,reply);
BeginUpdate(DrawWindow);
DrawContents;
DrawPalette;
EndUpdate(DrawWindow);
end
else
with reply do
begin
good := true;
GetWTitle(drawWindow,s);
fname := s;
vRefNum := fVref;
end;
if reply.good then
begin
err := SetVol(nil,reply.vRefNum);
ChkErr;
if saveas then
begin
err := FSDelete(reply.fname,reply.vRefnum);
if (err<>noErr) and (err<>fnfErr) then
ChkErr;
err := Create(reply.fname,reply.vRefnum,JPNT,PNTG);
ChkErr;
end;
err := FSOpen(reply.fname,reply.vrefnum,ref);
ChkErr;
if saveas then
begin
err := SetEOF(ref,512);
ChkErr;
err := SetFPos(ref,fsFromStart,0);
ChkErr;
l := 0;
n := 4;
err := FSWrite(ref,n,@l);{write version # 0}
ChkErr;
end;
err := SetFPos(ref,fsFromStart,512);
ChkErr;
with bm do
begin
SetRect(bounds,0,0,72*8,1);
baseAddr := @ar;
rowbytes := 72;
end;
SetRect(rr,0,0,576,1);
for i := 0 to 719 do
begin
setRect(r,0,i,576,i+1);
CopyBits(bmap,bm,r,rr,SrcCopy,nil);
srcPtr := @ar;
dstPtr := @dr;
PackBits(srcPtr,dstPtr,72);
n := ord(dstPtr)-ord(@dr);
err := FSWrite(ref,n,@dr);
ChkErr;
CheckQueue;
end;
err := FSClose(ref);
ChkErr;
SetWTitle(drawWindow,reply.fname);
fVref := reply.vRefnum;
changed := false;
saved := true;
end;
end;
Function MySaveProc(dlg:DialogPtr;Var theEvent:EventRecord;VAR IH:Integer):Boolean;
begin
SetUpA5;
MySaveProc:=false;
CheckQueue;
RestoreA5;
end;
Function Continue:Boolean;
var
choice : Integer;
begin
Continue:=true;
If changed then
begin
choice:=NoteAlert(2000,@MySaveProc);
Case Choice of
2:begin
SavePic(false);
If changed then
Continue:=false;
end;
3:Continue:=false;
end;
end;
end;
Procedure LoadPic;{ load picture }
var
where :point;
reply :SFReply;
err :integer;
ar:packed array [0..75] of byte;
n :longint;
i,j,ref:integer;
r,rr :rect;
bm:bitmap;
srcPtr,p :ptr;
dstPtr :ptr;
typeList :SFTypeList;
procedure ChkErr;
begin
if err <> 0 then
DoErr(err);
end;
begin
If not Continue then
exit(LoadPic);
SetPt(where,80,50);
typeList[0] := PNTG;
SFGetFile(where,Open document:,nil,1,typelist,@idleFilter,reply);
if reply.good then
begin
BeginUpdate(DrawWindow);
DrawContents;
DrawPalette;
EndUpdate(DrawWindow);
err := SetVol(nil,reply.vRefNum);
ChkErr;
err := FSOpen(reply.fname,reply.vrefnum,ref);
ChkErr;
err := SetFPos(ref,fsFromStart,512);
ChkErr;
with bm do
begin
SetRect(bounds,0,0,72*8,1);
baseAddr := @ar;
rowbytes := 72;
end;
err := GetEOF(ref,n);
ChkErr;
n := n-512;
p := NewPtr(n);
srcPtr := p;
err := FSRead(ref,n,srcPtr);
ChkErr;
SetRect(rr,0,0,576,1);
for i := 0 to 719 do
begin
dstPtr := @ar;
UnPackBits(srcPtr,dstPtr,72);
setRect(r,0,i,576,i+1);
CopyBits(bm,bmap,rr,r,SrcCopy,nil);
CheckQueue;
end;
disposPtr(p);
err := FSClose(ref);
ChkErr;
SetWTitle(drawWindow,reply.fname);
fVref := reply.vRefnum;
changed := false;
saved := true;
InvalRect(drect);
end;
end;
Procedure FadeIn(r:rect;pat:pattern);
var
v,h,x,i,n:longint;
begin
pennormal;
penpat(pat);
with r do
begin
v := bottom-top;
h := right-left;
for x := 1 to h do
begin
n := (x*v) div h;
for i := 1 to n do
begin
moveto(x+left,top+(i*v) div n);
line(0,0);
end;
end;
end;
end;
Procedure FadeOut(r:rect;pat:pattern);
var
v,h,x,i,n:longint;
begin
pennormal;
penpat(pat);
with r do
begin
v := bottom-top;
h := right-left;
for x := 1 to h do
begin
n := ((h-x)*v) div h;
for i := 1 to n do
begin
moveto(x+left,top+(i*v) div n);
line(0,0);
end;
end;
end;
end;
Procedure FadeInto(r:rect;inPat,outPat:pattern);
begin
SysBeep(1);
end;
Procedure PastePicture;
var
PPHdl : Handle;{ * Paste Picture handle * }
PTHdl : Handle;{ * Paste TEXT handle * }
Sclen : Longint;
offset : Longint;
anEvent: EventRecord;
PicRect: Rect;
err : Longint;
info : FontInfo;
TEXTStr: Str255;
TBox : Rect;
begin
err:=LoadScrap;
PPHdl:=NewHandle(0);
Sclen:=GetScrap(PPHdl,PICT,offset);
If Sclen<0 then
begin
PTHdl:=NewHandle(0);
Sclen:=GetScrap(PTHdl,TEXT,offset);
If Sclen>-1 then
begin
GetFontInfo(info);
GetiText(PTHdl,TEXTStr);
with DrawWindow^.portRect,info do
SetRect(TBox,left,top,left+StringWidth(TEXTStr)+1,top+ascent+descent+leading);
HLock(PTHdl);
PPHdl:=Handle(OpenPicture(TBox));
TextBox(PTHdl^,Sclen,TBox,teJustLeft);
ClosePicture;
HunLock(PTHdl);
end;
DisposHandle(PTHdl);
end;
If Sclen>-1 then
begin
SetCursor(ThePlacer^^);
Repeat
CheckQueue;
Until MyGetNextEvent(mDownmask,anEvent);
with anEvent do
begin
GlobalToLocal(where);
If (what=mouseDown) & (PtinRect(where,DrawWindow^.portRect) & not (PtInRect(where,prect)))
then
with PicHandle(PPHdl)^^.picFrame,where do
begin
ClipRect(dRect);
SetRect(PicRect,h,v,h+(right-left),v+(bottom-top));
DrawPicture(PicHandle(PPHdl),PicRect);
OffBits;
DrawPicture(PicHandle(PPHdl),PicRect);
OnBits;
ClipRect(DrawWindow^.portRect);
end;
end;
updateCurs:=true;
end;
DisposHandle(PPHdl);
end;
Procedure ResizeSprayKan;
var
ResizeBox: Rect;
CircleBox: Rect;
savePort : GrafPtr;
pt: Point;
tStr : Str255;
x,y : Integer;
newRad : Integer;
newSpeed : Integer;
sr: Integer; { * Save radius * }
procedure ShowSize(where:Point);
var
dx,dy,dd : Integer;
begin
with where do
begin
dx:=abs(x-h);
dy:=abs(y-v);
end;
If dx>dy
then
dd:=dx
else
dd:=dy;
If dd<sr then
EraseRect(ResizeBox);
sr:=dd;
SetRect(CircleBox,x-dd,y-dd,x+dd,y+dd);
FillOval(CircleBox,Black);
newRad:=dd;
end;
begin
GetPort(savePort);
Dlg:=GetNewDialog(1001,Nil,Pointer(-1));
HiliteButton(Dlg);
SetCursor(theSizer^^);
newRad:=UT[0].splatRad;
PenNormal;
GetDItem(Dlg,5,iType,iTem,Box);
newSpeed:=UT[0].splatSpeed;
SetiText(iTem,Str(newSpeed));
SeliText(Dlg,5,0,255);
GetDItem(Dlg,3,iType,iTem,Box);
ResizeBox:=Box;
InsetRect(Box,-1,-1);
FrameRect(Box);
sr:=newRad;
with ResizeBox do
begin
x:=left+(right-left) Div 2;
y:=top+(bottom-top) Div 2;
SetRect(CircleBox,x-sr,y-sr,x+sr,y+sr);
end;
FillOval(CircleBox,Black);
ItemHit:=0;
Repeat
CheckQueue;
If MyGetNextEvent(everyEvent,myEvent) then
If isDialogEvent(myEvent) then
if DialogSelect(myEvent,Dlg,itemHit) then
Case itemHit of
ok: begin
GetDItem(Dlg,5,iType,iTem,Box);
GetiText(iTem,tStr);
newSpeed:=Val(tStr);
If newSpeed<1
then
begin
SysBeep(1);
newSpeed:=1;
end
else if newSpeed>255 then
begin
SysBeep(1);
newSpeed:=255;
end;
end;
3:with myEvent do
begin
GlobalToLocal(where);
pt:=where;
ShowSize(where);
Repeat
GetMouse(where);
If PtinRect(where,ResizeBox) then
If longInt(where)<>longInt(pt) then
begin
ShowSize(where);
pt:=where;
end;
CheckQueue;
Until Not StillDown;
end;
end; { case }
Until ItemHit in [ok,cancel];
If ItemHit=ok then
begin
with LAPwbuf do
begin
theType := setSplat;
sRad := newRad;
sSpeed := newSpeed;
end;
SendLAP(255);
end;
DisposDialog(Dlg);
SetPort(savePort);
end;
Procedure ToolClick(pt:point);
var
i,a,h,v:integer;
dblClick :boolean;
where :point;
outColor :RGBColor;
begin
dblClick := (TickCount-clickTime<GetDblTime); { possible double
click? }
clickTime := TickCount;
a := 0;
for i := 1 to 20 do
if ptInRect(pt,toolRects[i]) then
begin
a := i;
leave;
end;
dblClick:=(a=lastTool) and dblClick;
if a>0 then
begin
lastTool := a;
case a of
1:begin{ spray can }
with LAPwbuf do
begin
theType := paintMode;
mode := not UT[0].theMode;
end;
SendLAP(255);
PenMode(PatXOR);
PenPat(ltgray);
PaintRect(toolRects[Tspray]);
PenNormal;
end;
2..9: if dblClick then
case a of
TErase:begin
LAPwbuf.theType := eraseall;
SendLAP(255);
end;
TSplatter:
ResizeSprayKan;
end
else
with UT[0] do { Handle new tools }
if theTool<>a then
begin
InvertRect(ToolRects[theTool]);
InvertRect(ToolRects[a]);
ChangeTool(a);
end;
10: begin { disk icon }
end;
11,12: if (PatternsUp<>(a=11)) and MacII then
{ pattern/color switch }
begin
PenMode(PatXOR);
PenPat(ltgray);
PaintRect(toolRects[Tpat]);
PaintRect(toolRects[Tcolor]);
PenNormal;
PatternsUp := not PatternsUp;
if PatternsUp then
DisplayPatterns
else
DisplayColors;
end
else if PatternsUp<>(a=11) then
sysbeep(1);
13..20:if dblClick then
begin
if patternsUp then
begin
PatternEditor(thePatterns[a-12]);
with LAPwbuf do
begin
theType := setpat;
pat := thePatterns[a-12];
end;
SendLAP(255);
curPat := a-12;
DisplayPatterns;
end
else
begin
{ color picker }
SetPt(where,0,0);
{ * The color picker will center itself * }
if GetColor(where,Set Pallete color to:,theColors[a-12],outColor)
then
begin
theColors[a-12]:=outColor;
with LAPwbuf do
begin
theType := setcolor;
clr := outColor;
end;
SendLAP(255);
end;
curColor := a-12;
DisplayColors;
end;
end
else { single click }
begin
if PatternsUp and (curPat<>a-12) then { pattern/color selection }
begin
with LAPwbuf do
begin
theType := setpat;
pat := thePatterns[a-12];
end;
SendLAP(255);
curPat := a-12;
FillRect(curPatRect,thePatterns[curPat]);
end
else if not(patternsUp) and (curColor<>a-12) then
begin
with LAPwbuf do
begin
theType := setcolor;
clr := theColors[a-12];
end;
SendLAP(255);
curColor := a-12;
RGBForeColor(theColors[curColor]);
PaintRect(curPatRect);
end;
end;
end;
updateCurs := true;
end
else if PtInRect(pt,hSizeRect) then
begin
v := UT[0].vSize;
h := DoSizeTool(pt,hSizeRect,UT[0].hSize);
with LAPwbuf do
begin
theType := setPen;
px := h;
py := v;
end;
SendLAP(255);
updateCurs:=true;
end
else if PtInRect(pt,vSizeRect) then
begin
h := UT[0].hSize;
v := DoSizeTool(pt,vSizeRect,UT[0].vSize);
with LAPwbuf do
begin
theType := setPen;
px := h;
py := v;
end;
SendLAP(255);
updateCurs := true;
end;
end;
Function Sgn(i:integer):integer;
begin
if i<0 then
sgn := -1
else if i>0 then
sgn := 1
else
sgn := 0;
end;
Procedure MakeRect(pt1:point);
var
LastPt,pt:point;
x,y :integer;
dx,dy :integer;
r :rect;
begin
lastPt := pt1;
with pt1 do
begin
x := h;
y := v;
end;
Repeat
GetMouse(Pt);
if pt.h>drect.right then {pin mouse inside drect}
pt.h := drect.right
else if pt.h<drect.left then
pt.h := drect.left;
if pt.v>drect.bottom then
pt.v := drect.bottom
else if pt.v<drect.top then
pt.v := drect.top;
if longint(LastPt)<>longint(pt) then{ mouse moved } { NOTE: this is
faster than EqualPt }
begin
{ -- erase old rect -- }
SetRect(r,x,y,LastPt.h,LastPt.v);
if x>LastPt.h then
begin
r.left := LastPt.h;
r.right := x;
end;
if y>LastPt.v then
begin
r.top := LastPt.v;
r.bottom := y;
end;
CopyBits(bmap,Wbits,r,r,srcCopy,nil); { flicker-matic quick fix }
{ -- check for shift constraint -- }
if bitAnd(mods,shiftKey)<>0 then
begin
dx := abs(pt.h-pt1.h);
dy := abs(pt.v-pt1.v);
if dy<dx then
pt.h := pt1.h + dy*sgn(pt.h-pt1.h)
else
pt.v := pt1.v + dx*sgn(pt.v-pt1.v);
end;
{ -- calculate new rect -- }
SetRect(r,x,y,pt.h,pt.v);
if x>pt.h then
begin
r.left := pt.h;
r.right := x;
end;
if y>pt.v then
begin
r.top := pt.v;
r.bottom := y;
end;
{ -- fix mistakes -- }
with UT[0] do
{ set my user state cuz checkqueue screws it up }
begin
PenPat(thePat);
if MacII then
RGBForeColor(theClr);
PenSize(hSize,vSize);
end;
{ -- draw rect -- }
case UT[0].theTool of
TRect: begin
if bitAnd(mods,optionKey)=0 then
PenPat(black);
FrameRect(r);
end;
TFRect:begin
PaintRect(r);
if bitAnd(mods,optionKey)=0 then
begin
PenPat(black);
FrameRect(r);
end;
end;
TOval: begin
if bitAnd(mods,optionKey)=0 then
PenPat(black);
FrameOval(r);
end;
TFOval:begin
PaintOval(r);
if bitAnd(mods,optionKey)=0 then
begin
PenPat(black);
FrameOval(r);
end;
end;
end;
end;
LastPt := pt;
CheckQueue;
Until MyGetNextEvent(mupmask,myEvent);
with LAPwbuf do
begin
theType := rectpck; { send rectpck packet }
rct := r;
optDown := (bitAnd(mods,optionKey)<>0);
end;
SendLAP(255);
{ send message to everyone }
end;
Procedure MasterClick(pt:Point);{mouseDown our window}
var
LastPt :Point;
dx,dy :integer;
mypart :integer;
begin
{ * If a DA then get of of here * }
if windowPeek(FrontWindow)^.windowKind<0 then
exit(MasterClick);
if PtInRect(pt,prect) then { click in palette }
ToolClick(pt)
else
begin
if UT[0].theTool in [TRect..TFOval] then
MakeRect(pt)
else
begin
with LAPwbuf do
begin
theType := setpos;{ send setpos packet }
mx := pt.h;
my := pt.v;
end;
SendLAP(255); {send setpos packet to everyone}
Repeat
GetMouse(Pt);
if pt.h>drect.right then { pin mouse inside drect }
pt.h := drect.right
else if pt.h<drect.left then
pt.h := drect.left;
if pt.v>drect.bottom then
pt.v := drect.bottom
else if pt.v<drect.top then
pt.v := drect.top;
if (longint(LastPt)<>longint(Pt)) | (UT[0].TheTool=Tsplatter) then
{ mouse moved } { NOTE: this is faster than EqualPt }
begin
with LAPwbuf do
begin
theType := drag;{send drag packet}
cx := pt.h;
cy := pt.v;
end;
SendLAP(255); {send message to everyone}
LastPt := Pt;
end;
CheckQueue;
Until MyGetNextEvent(mupmask,myevent);
end;
end;
end;
Procedure MasterKey(theChar:char);
begin
if UT[0].theTool = Tletters then
if theChar>= then
begin
with LAPwbuf do
begin
theType := alpha;
ch := theChar;
end;
SendLAP(255);
end;
end;
Procedure ChangeFont;
var
s :str255;
i :integer;
begin
CheckItem(myMenus[fontMenu],theFontidx,false);
theFontidx:=theItem;
GetItem(mymenus[fontMenu],theItem,s);
GetFNum(s,theItem);
CheckItem(myMenus[fontMenu],theFontidx,true);
with UT[0] do
if theItem<>theFNum then
begin
with LAPwbuf do
begin
theType := setfont;
fnum := theItem;
fsize := theFSize;
fstyl := theFstyle;
end;
SendLAP(255);
end;
for i:=1 to 9 do
begin
GetItem(myMenus[sizeMenu],i,s);
if RealFont(theItem,Val(s))
then
SetItemStyle(myMenus[sizeMenu],i,[Outline])
else
SetItemStyle(myMenus[sizeMenu],i,[]);
end;
end;
procedure ChangeStyle;
const
plainItem= 1;
var
markChar :char;
StyleArray :packed array [1..7] of styleitem;
i :integer;
CStyle :style;
begin
CStyle:=UT[0].theFStyle;
StyleArray[1]:=Bold;
StyleArray[2]:=Italic;
StyleArray[3]:=Underline;
StyleArray[4]:=Outline;
StyleArray[5]:=Shadow;
StyleArray[6]:=Extend;
StyleArray[7]:=Condense;
If theitem=plainItem then
begin
CheckItem(myMenus[styleMenu],1,true);
for i:=2 to 8 do
CheckItem(myMenus[styleMenu],i,false);
CStyle:=[];
end
else
begin
CheckItem(myMenus[styleMenu],1,false);
GetItemMark(myMenus[styleMenu],theitem,markChar);
If markChar=chr(noMark) then
begin
CStyle:=CStyle+[StyleArray[theitem-1]];
CheckItem(myMenus[styleMenu],theitem,True);
end
else
begin
CheckItem(myMenus[styleMenu],theitem,false);
CStyle:=CStyle-[StyleArray[theitem-1]];
If CStyle=[] then
CheckItem(myMenus[styleMenu],1,true);
end;
end;
if CStyle<>UT[0].theFStyle then
begin
with LAPwbuf do
begin
theType := setfont;
with UT[0] do
begin
fNum := theFNum;
fSize := theFSize;
fStyl := CStyle;
end;
end;
SendLAP(255);
end;
end;
Procedure ChangeSize;
var
s :str255;
begin
if theSizeidx<>theItem then
begin
CheckItem(myMenus[sizeMenu],theSizeidx,false);
CheckItem(myMenus[sizeMenu],theItem,true);
theSizeidx:=theItem;
GetItem(mymenus[sizeMenu],theItem,s);
theItem:=Val(s);
with UT[0] do
begin
with LAPwbuf do
begin
theType := setfont;
fnum := theFNum;
fsize := theItem;
fstyl := theFstyle;
end;
SendLAP(255);
end;
end;
end;
Procedure DrawContents; { redraw drawing }
begin
SetPort(DrawWindow);
CopyBits(bmap,wbits,drect,drect,SrcCopy,Nil);
end;
Procedure PrintPic; { print a document }
var
GetOutEh : Boolean;
temphPrint : THPrint;
err : OSErr;
savePort : GrafPtr;
myPrPort : TPPrPort;
myStRec: TPrStatus;
i : Integer;
begin
temphPrint:=hPrint;
err:=HandToHand(handle(temphPrint));
if Err<>NoErr then
begin
SysBeep(1);
exit(PrintPic);
end;
PrOpen;
if PrJobDialog(temphPrint)
then
begin
GetOutEh:=false;
DisposHandle(handle(hPrint));
If MemError<>NoErr then
SysBeep(1);
hPrint:=temphPrint;
err:=HandToHand(handle(hPrint));
If Err<>NoErr then
begin
SysBeep(1);
GetOutEh:=true;
end;
end
else
GetOutEh:=true;
PrClose;
DisposHandle(handle(temphPrint));
if GetOutEh then
exit(PrintPic);
BeginUpdate(DrawWindow);
DrawContents;
DrawPalette;
EndUpdate(DrawWindow);
GetPort(savePort);
for i:=1 to hPrint^^.PrJob.iCopies do
begin
PrOpen;
If PrError=noErr then
begin
myPrPort:=PrOpenDoc(hPrint,Nil,Nil);
If PrError=noErr then
begin
PrOpenPage(myPrPort,Nil);
If PrError=noErr then
CopyBits(bmap,myPrPort^.gPort.portBits,bmap.bounds,bmap.bounds,SrcCopy,Nil);
PrClosePage(myPrPort);
end;
end;
If PrError=noErr then
PrCloseDoc(myPrPort);
If (hPrint^^.prJob.bjDocLoop=bSpoolLoop) and (PrError=NoErr) then
PrPicFile(hPrint,Nil,Nil,Nil,myStRec);
PrClose;
end;
SetPort(savePort);
end;
Procedure DoMyUpdate;
var
savePort :grafPtr;
tempWindow :windowPtr;
begin
tempWindow:=WindowPtr(myEvent.message);
GetPort(savePort);
SetPort(tempWindow);
BeginUpdate(tempWindow);
if tempWindow=DrawWindow then
begin
DrawContents;
DrawPalette;
end;
EndUpdate(tempWindow);
SetPort(savePort);
end;
Procedure DoJamAbout;
const
picID = 999;
var
AboutWindow: WindowPtr;
AboutPict: PicHandle;
AboutRect: Rect;
AboutEvent : Eventrecord;
SavePort : GrafPtr;
x1,y1,x2,y2: Integer;
begin
GetPort(SavePort);
AboutPict:=PicHandle(GetResource(PICT,999));
RsrcErr;
with ScreenBits.Bounds do
begin
x1:=right-left;
y1:=bottom-top;
end;
with AboutPict^^.picFrame do
begin
x2:=right-left;
y2:=bottom-top;
end;
SetRect(AboutRect,1,1,x2,y2);
AboutWindow:=NewWindow(Nil,AboutRect,,false,1,Pointer(-1),false,0);
MoveWindow(AboutWindow,(x1-x2) Div 2,(y1-y2) Div 2,true);
ShowWindow(AboutWindow);
SetPort(AboutWindow);
with AboutPict^^.picFrame do
SetRect(AboutRect,0,0,right-left,bottom-top);
DrawPicture(AboutPict,AboutRect);
Repeat
CheckQueue;
Until MyGetNextEvent(mdownMask+keyDownMask+AutoKeyMask,AboutEvent);
ReleaseResource(handle(AboutPict));
RsrcErr;
DisposeWindow(AboutWindow);
SetPort(SavePort);
end;
Procedure DoCommand(mResult:longint); {menu commands}
var
name : Str255;
begin
theMenu := HiWord(mResult);
theItem := LoWord(mResult);
if BitAnd(myEvent.modifiers,CmdKey) <> 0 then
HiliteMenu(theMenu);
case theMenu of
255: If theItem <> 1 then
begin
GetItem(myMenus[appleMenu],theItem,name);
refnum:=OpenDeskAcc(name);
end
else If WindowPeek(FrontWindow)^.windowKind > 0 then
DoJamAbout
else
SysBeep(1);
256: case theItem of{ main menu }
1: LoadPic;
2: SavePic(false);
3: SavePic(true);
{ ------ }
5: DoPageSetUp;
6: PrintPic;
{ ------ }
8: If Continue then
doneFlag:=true;
10:begin
PrDebug := not PrDebug;
if PrDebug then
begin
PrCtlCall(iPrDevCtl,$00010000,0,0);
debug(--> Debug transcript follows);
end;
end;
end;
257: ChangeFont;
258: ChangeSize;
259: ChangeStyle;
260: case theItem of
1: FadeIn(drawWindow^.portRect,UT[0].thePat);
2: FadeOut(drawWindow^.portRect,UT[0].thePat);
3: FadeInto(drawWindow^.portRect,black,white);
end;
end;
HiliteMenu(0);
end;
Procedure InitTables; { initialize User Table, Queue }
var
i :integer;
begin
with PQ do { empty queue }
begin
head := 0;
tail := 0;
end;
with UT[0] do
begin
id := myNode;
theTool := dTool; { default tool }
theMode := dMode; { default mode }
thePat := black;{ default pattern }
theClr := theColors[dColor]; { default to black }
hSize := dPen; { default pensize }
vSize := dPen; { default pensize }
theFnum := applFont;{ default text font }
theFsize := dSize;{ default text size }
theFstyle := dStyle;{ default text style }
x := 100;{ somewhere on the screen }
y := 50;
splatSpeed := dsplatterCount;{ default speed }
splatRad := dsplatRad; { default radius }
{ time needs no initialization }
end;
for i := 1 to maxUsers do
begin
UT[i] := UT[0];
UT[i].id := -1; { invalidate all users }
end;
end;
Procedure ReadPatCol;{read patterns & colors into memory}
var
RGBColors:CHandle;
i :integer;
begin
for i:=1 to 8 do
GetIndPattern(thePatterns[i],128,i);RGBColors:=CHandle(GetResource(CLRS,128));
RsrcErr;
theColors:=RGBColors^^;
ReleaseResource(handle(RGBColors));
RsrcErr;
end;
Procedure InitGlob; { init globals, user table, etc. }
const
UnImplTrapNum = $9F; { * Unimplemented trap * }
WaitNextEventTrapWord = $60;
var
i,j :integer;
Rom,Machine:integer;
theWorld :SysEnvRec;
begin
{ * Get the world, so to speak * }
if SysEnvirons(1,theWorld)<>envNotPresent then
begin
MultiFinderRunning:=(theWorld.machineType>=0) & (NGetTrapAddress(WaitNextEventTrapWord,ToolTrap)<>NGetTrapAddress(UnImplTrapNum,ToolTrap));
ColorQDrawImplm:=theWorld.hasColorQD;
end
else
begin
MultiFinderRunning:=false;
ColorQDrawImplm:=false;
end;
Environs(Rom,Machine);
if Machine=2
then
MacII:=true
else
MacII:=false;
PixDraw:=false;
{ * Controls if mac II pix map is working or not * }
MacII:=false;
PrDrvrOpen;
PrDebug := false; { *** for debugging only *** }
err := MPPOpen; { open Appletalk driver }
if err<>noErr then
begin
SysBeep(1);
exitToShell;
end;
err := GetNodeAddress(myNode,myNet);{ who am I? }
if err<>noErr then
begin
SysBeep(1);
exitToShell;
end;
err := LapOpenProtocol(OurType,nil);{ open our protocol type }
if err<>noErr then
begin
SysBeep(1);
exitToShell;
end;
LAPrh := ABRecHandle(newHandle(lapSize));{ handle for LAP reads }
LAPwh := ABRecHandle(newHandle(lapSize));{ handle for LAP writes }
HLock(handle(LAPrh));
HLock(handle(LAPwh));
hPrint:=THPrint(NewHandle(SizeOf(TPrint)));
SetUpRead; { set up initial LAPRead }
palette := PicHandle(GetResource(PICT,1000));
RsrcErr;
jamPic := PicHandle(GetResource(PICT,1001));
RsrcErr;
for i := 1 to 20 do
begin
j := (i-1) div 2;
if odd(i) then
SetRect(ToolRects[i],0,20*j,22,20*(j+1)-1)
else
SetRect(ToolRects[i],23,20*j,45,20*(j+1)-1);
end;
SetRect(curPatRect,3,203,42,225);
SetRect(hSizeRect,0,231,21,266);
SetRect(vSizeRect,23,231,44,266);
PatternsUp := true;
curPat := 1;
curColor := 1;
ReadPatCol;
PatternsUp:=true;
for i := 0 to 15 do
theCurs.mask[i] := 0;
setPt(theCurs.hotspot,0,0);
setPt(theECurs.hotspot,0,0);
arrowCurs := true;
updateCurs := false;
InitTables;
OpenDrawWindow;
textMode(SrcCopy);
clickTime := 0; { set up doubleclick variables }
lastTool := -1;
DoneFlag := false;
theSizeidx := 3;
changed := false;
theSizer:=GetCursor(1000);
theHand:=GetCursor(1001);
thePlacer:=GetCursor(1002);
theSprayer:=GetCursor(1003);
end;
Procedure CleanUp;
{All of this isnt really necessary except for closing our protocol type.
The application heap will be flushed anyway, but we ought to set a good
example....}
begin
PrDrvrClose;
if LAPrh^^.abResult=1 then{stop LAP read if in on}
begin
err := LAPRdCancel(LAPrh);
DoErr(1004);
end;
if not polling then
begin
err := VRemove(@myTask); { remove VBLTask }
DoErr(1005);
end;
err := LAPCloseProtocol(OurType); {!! close protocol !!}
DoErr(1000);
err := MPPClose;{ close AppleTalk driver }
DoErr(1002);
DisposHandle(handle(LAPrh));
DisposHandle(handle(LAPwh));
releaseResource(handle(palette));
RsrcErr;
releaseResource(handle(jamPic));
RsrcErr;
if PixDraw
then
begin
end
else
DisposPtr(bmap.baseAddr);
end;
procedure _DataInit;EXTERNAL;
begin
UnloadSeg(@_DataInit); {* Get rid of MPWs init code *}
FlushEvents(everyEvent,0);
InitGraf(@thePort);
InitFonts;
TEInit;
InitWindows;
InitDialogs(Nil);
InitCursor;
SetUpMenus;
InitGlob;
Repeat
FixCursor;
CheckQueue;{ something for us to do while we idle }
if MyGetNextEvent(everyEvent,myEvent) then
with myEvent do
case what of
mouseDown:
begin
mods := modifiers;
code := FindWindow(where,tempWindow);
case code of
inMenuBar: DoCommand(MenuSelect(where));
InSysWindow: SystemClick(myEvent,tempWindow);
inContent,InDrag:
if tempWindow <> frontWindow then
begin
SelectWindow(tempWindow);
SetPort(tempWindow);
end
else if FrontWindow=DrawWindow then
begin
GlobalToLocal(where);
MasterClick(where);
end;
end;
end;
keyDown, autoKey:
begin
theChar := chr(BitAnd(message,255));
if BitAnd(modifiers,CmdKey)<>0 then
begin
if theChar in [v,V] then
PastePicture
else
DoCommand(MenuKey(theChar))
end
else
MasterKey(theChar);
end;
updateEvt:
DoMyUpdate;
activateEvt:
if Odd(modifiers) then
begin
tempWindow:=WindowPtr(message);
SetPort(tempWindow);
If tempWindow=DrawWindow then
begin
updateCurs:=true;
{ * Remove Edit menu/ we dont use it, but DAs might * }
If FileMenuPresent then
begin
FileMenuPresent:=false;
DeleteMenu(261);
DrawMenuBar;
end;
end
else
SetCursor(arrow);
end
else
begin
{ * If our about caused it then give them an Edit menu * }
if (WindowPtr(message)=DrawWindow) & (not FileMenuPresent) & (windowPeek(FrontWindow)^.windowKind<0)
then
begin
FileMenuPresent:=true;
InsertMenu(myMenus[EditMenu],257);
DrawMenuBar;
end;
end;
end;
Until doneflag;
CleanUp;
SetCursor(GetCursor(WatchCursor)^^);
end.
Listing: JamPaint.r
/* resources for JamPaint.p */
Type JpNT as STR ;
resource JpNT (0) {JamPaint by Edgar Circenis and Rod Magnuson --
Dec 28, 1987};
resource FREF (128) {APPL, 0, };
resource BNDL (128) {
JpNT, 0, {ICN#, {0, 128};FREF, {0, 128}}};
resource MENU (255, Apple, preload) {
255,textMenuProc,0x7FFFFFD,enabled,apple,
{ About JamPaint, noIcon, , , plain,
-, noIcon, , , plain}};
resource MENU (256, File, preload) {
256, 0, 0x7FFFFFB7, enabled, File,
{ Open ,noicon, O, nomark, plain;
Save,noicon, S, nomark, plain;
Save as ,noicon, noKey, nomark, plain;
-,noicon, noKey, nomark, plain;
Page Setup ,noicon, nokey, nomark, plain;
Print ,noicon, P, nomark, plain;
-,noicon, noKey, nomark, plain;
Quit,noicon, Q, nomark, plain}};
resource MENU (257, Font, preload) {
257, 0, 0x7FFFFFFF, enabled, Font,{}};
resource MENU (258, Size, preload) {
258,textMenuProc,allEnabled,enabled,Size,
{
9, noIcon, , , plain,
10, noIcon, , , plain,
12, noIcon, , check, plain,
14, noIcon, , , plain,
18, noIcon, , , plain,
24, noIcon, , , plain,
36, noIcon, , , plain,
48, noIcon, , , plain,
72, noIcon, , , plain}};
resource MENU (259, Style, preload) {
259, textMenuProc,allEnabled,enabled,Style,
{
Plain, noIcon, , check, plain,
Bold, noIcon, B, , 1,
Italic, noIcon, I, , 2,
Underline, noIcon, U, , 4,
Outline, noIcon, , , 8,
Shadow, noIcon, , , 16,
Extend, noIcon, , , 64,
Condense, noIcon, , , 32}};
resource MENU (260, Effects, preload) {
260, textMenuProc,allEnabled,enabled,Effects,
{ Fade In,noicon, noKey, nomark, plain;
Fade Out,noicon, noKey, nomark, plain;
Fade from/to,noicon, noKey, nomark, plain}};
\resource MENU (261, Edit, preload) {
261,textMenuProc,0x7FFFFFFC,enabled,Edit,
{ Cant Undo, noIcon, Z, , plain,
-, noIcon, , , plain,
Cut, noIcon, X, , plain,
Copy, noIcon, C, , plain,
Paste, noIcon, V, , plain,
Clear, noIcon, , , plain}};
resource WIND (129, Paint Window, preload) {
{39,10,341,502},
noGrowDocProc, visible, nogoaway, 0x0, Untitled;};
resource ALRT (2000) {
{78, 122, 234, 364},2000,
{ Cancel, visible, sound1,
Cancel, visible, sound1,
Cancel, visible, sound1,
Cancel, visible, sound1}};
resource DITL (2000) {
{ {112, 32, 132, 92},
Button {enabled,Discard},
{72, 32, 92, 92},
Button {enabled,Save},
{72, 136, 92, 196},
Button {enabled,Cancel},
{24, 96, 40, 200},
StaticText {disabled,Save changes?}}};
resource DLOG (1000, Pattern Editor) {
{78, 148, 208, 374},
dBoxProc,visible,noGoAway,0x0,1000,};
resource DITL (1000) {
{ {104, 152, 124, 212},
Button {enabled,Ok},
{104, 80, 124, 140},
Button {enabled,Cancel},
{8, 24, 88, 104},
UserItem {enabled},
{8, 128, 88, 208},UserItem {disabled}}};
resource DLOG (1001, Resize Spray Kan) {
{46, 98, 266, 410},
dBoxProc,visible,noGoAway,0x0,1001,};
resource DITL (1001, Resize Spray Kan) {
{ {176, 232, 196, 292},
Button {enabled,OK},
{144, 232, 164, 292},
Button {enabled,Cancel},
{16, 16, 208, 208},
UserItem {enabled},
{40, 224, 56, 296},
StaticText {disabled,Flow Rate},
{70, 234, 84, 288},
EditText {enabled,}}};
resource DLOG (1002, Printing Error!) {
{36, 108, 80, 392},
dBoxProc,visible,noGoAway,0x0,1002,};
resource DITL (1002, Printing Error!) {
{ {13, 37, 29, 253},
StaticText {disabled,An error while printing occured!}}};
data CLRS (128,colors, preload){
$0000 0000 0000" /* BLACK */
$FFFF FFFF FFFF /* WHITE */
$FFFF 0000 0000" /* RED */
$0000 FFFF 0000" /* GREEN */
$0000 0000 FFFF /* BLUE */
$FFFF FFFF 0000" /* YELLOW */
$0000 FFFF FFFF /* TURQUOISE */
$FFFF 0000 FFFF /* MAGENTA */
};
resource PAT# (128,Patterns, preload) {
{
/* [Black] */
$FFFF FFFF FFFF FFFF,
/* [Dk Gray] */
$DDFF 77FF DDFF 77FF,
/* [Med Gray] */
$DD77 DD77 DD77 DD77",
/* [Gray] */
$AA55 AA55 AA55 AA55",
/* [White] */
$0000 0000 0000 0000",
/* [Spot White] */
$8000 0800 8000 0800",
/* [More Spots White] */
$8800 2200 8800 2200",
/* [Still More Spots White] */
$8822 8822 8822 8822",
/* [And Still More Spots White] */
$AA00 AA00 AA00 AA00"
}
};
include JamPaint.rsrc; /* additional resources */
include JamPaint.code;