gt3070b@prism.gatech.EDU (Jeff Watkins) (05/30/90)
unit GWin;
interface
const
LockSize=1;
LockOpen=2;
LockPos=4;
type
CapPtr= ^Capsule;
procPtr= Procedure(C:CapPtr);
Capsule= object
w,h: integer;
Fresh: boolean;
Title: string[40];
end;
Function NewProcess(w,h:integer;A:byte;Proc,Ref:ProcPtr;T:string):byte;
Procedure KillProcess(Cap:byte);
Procedure CheckProcess;
Function ProcessDone(Cap:byte):boolean;
Procedure NulProcess(C:CapPtr);
Procedure NulRefresh(C:CapPtr);
Function AllDone:boolean;
implementation
uses gutil,mouse,GMenu,Graph,dos,Fonts;
const
NumCapsules= 50;
type
WindowPtr= ^Window;
Window= object(Capsule)
{ Pmenu: menuptr;}
x,y: integer;
attr: byte;
drawn: boolean;
LineS: LineSettingsType;
TextS: TextSettingsType;
Point: PointType;
Next: WindowPtr;
Prev: WindowPtr;
Process: ProcPtr;
Refresh: ProcPtr;
procedure Redraw;
procedure DrawAll;
constructor Init(wx,wy,ww,wh:word;a:byte;FN:string);
procedure SetTitle(T:string);
destructor Done;
procedure SetActive;
procedure SetView;
procedure Size;
procedure Move;
procedure DrawCovered;
procedure DrawCovering;
procedure SaveSettings;
procedure SetProc(Proc,Ref:ProcPtr);
procedure SetAttr(LOpen,LSize,LPos:boolean);
function Event(mxx,myy:integer;but1,but2,but3:boolean):boolean;
function AllClosed:boolean;
function Covers(W1:Window):boolean;
function Covered:boolean;
function Covering:boolean;
procedure Check;
end;
Var
Active: WindowPtr;
oldmin: word;
oldhrs: word;
Count: longint;
SavePtr: Pointer;
Clock: Window;
gd,gm: integer;
Capsules: array[0..NumCapsules] of Window;
Procedure Window.SetProc(Proc,Ref:ProcPtr);
begin
Process:=Proc;
Refresh:=Ref;
end;
procedure Window.Redraw;
var
TS: TextSettingsType;
begin
SetViewPort(0,0,MaxX,MaxY,true);
if (attr and LockPos)<>LockPos then
begin
VertScroll(x,y+15,y+h-16);
HorizScroll(x+15,y+h-15,x+w-1);
VBar(x,y+15,y+h-16,0,(h-64)/MaxY);
HBar(x+15,y+h-15,x+w-1,0,(w-64)/MaxX);
UBox(x,y+h-15,x+14,y+h-1);
UBox(x+15,y+15,x+w-1,y+h-16);
end
else
UBox(x,y+15,x+w-1,y+h-1);
if (attr and LockOpen)<>LockOpen then
begin
UBox(x,y,x+14,y+14);
UBox(x+15,y,x+w-1,y+14);
DBox(x+2,y+2,x+12,y+12);
end
else
UBox(X,y,x+w-1,y+14);
gettextsettings(TS);
setcolor(8);
SetTextStyle(SmallFont,HorizDir,0);
SetTextJustify(CenterText,TopText);
if (attr and LockOpen)=LockOpen then
begin
SetViewPort(x+1,y,x+w-2,y+16,true);
hidem;
OutTextXY(w div 2,2,title);
showm;
end
else
begin
setViewPort(x+16,y,x+w-2,y+16,true);
hidem;
OutTextXY((w-16) div 2,2,title);
showm;
end;
SetView;
with ts do
begin
setTextStyle(Font,Direction,CharSize);
SetTextJustify(Horiz,Vert);
end;
fresh:=false;
drawn:=true;
end;
procedure Window.SaveSettings;
begin
GetTextSettings(TextS);
GetLineSettings(Lines);
Point.x:=GetX;
Point.y:=GetY;
end;
procedure Window.SetView;
begin
if (attr and LockPos)=LockPos then
SetViewPort(x+1,y+16,x+w-2,y+h-2,true)
else
SetViewPort(x+16,y+16,x+w-2,y+h-17,true);
with TextS do
begin
SetTextStyle(Font,Direction,CharSize);
SetTextJustify(Horiz,Vert);
end;
with Lines do
SetLineStyle(LineStyle,Pattern,Thickness);
with Point do
MoveTo(x,y);
end;
procedure Window.SetActive;
begin
if Active=\@self then
exit;
if Prev<>Nil then
Prev^.Next:=Next;
if (Next<>nil) and (Prev<>Nil) then
Next^.Prev:=Prev;
if Active<>Nil then
Next:=Active;
Prev:=Nil;
if active<>Nil then
Active^.SaveSettings;
Redraw;
SetView;
if active<>nil then
Active^.Prev:=\@Self;
Active:=\@Self;
end;
Destructor Window.Done;
begin
{ KillMenu(PMenu);}
hidem;
setViewPort(0,0,MaxX,MaxY,true);
setcolor(0);
setfillstyle(1,0);
bar(x,y,x+w-1,y+h-1);
showm;
if covered then
DrawCovering;
if covering then
DrawCovered;
DrawCovered;
if Active<>\@Self then
begin
if prev<>nil then
Prev^.Next:=Next;
if Next<>nil then
Next^.Prev:=Prev;
end
else
begin
Active:=Nil;
if Next<>Nil then
begin
Next^.Prev:=nil;
Next^.SetActive;
end;
showm;
end;
x:=-1;
end;
{$F+}
procedure NulRefresh(C:CapPtr);
begin
setcolor(random(16));
lineto(random(C^.w),Random(C^.h));
end;
Procedure NulProcess(C:CapPtr);
begin
C^.Fresh:=false;
inc(Count);
end;
{$F-}
procedure Window.SetAttr(LOpen,LSize,LPos:boolean);
begin
if LOpen then
attr:=attr or LockOpen;
if LSize then
attr:=attr or LockSize;
if LPos then
attr:=attr or LockPos;
end;
Constructor Window.Init(wx,wy,ww,wh:word;A:byte;fn:string);
begin
Title:='';
attr:=a;
x:=wx;
y:=wy;
w:=ww;
h:=wh;
Process:=NulProcess;
Refresh:=NulRefresh;
Texts.Font:=SmallFont;
TextS.Direction:=HorizDir;
TextS.charSize:=0;
Point.x:=0;
Point.y:=0;
drawn:=false;
Prev:=Nil;
Next:=Active;
Fresh:=false;
SetActive;
{ PMenu:=LoadMenu(FN);}
end;
function Window.Covering:boolean;
var
w1: windowPtr;
C: boolean;
begin
C:=false;
w1:=\@Self;
while (w1^.next<>nil) and not C do
begin
w1:=w1^.next;
if (w1^.x-x<w) and (x<w1^.x+w1^.w) and
(w1^.y-y<h) and (y<w1^.y+w1^.h) then
C:=true;
end;
Covering:=C;
end;
function Window.Covers(w1:Window):boolean;
begin
covers:=false;
if (w1.x=x) and (w1.w=w) and (w1.h=h) and (w1.y=y) then
exit;
if (w1.x-x<w) and (x<w1.x+w1.w) and
(w1.y-y<h) and (y<w1.y+w1.h) then
Covers:=true;
end;
function Window.Covered:boolean;
var
w1: windowPtr;
C: boolean;
begin
C:=false;
w1:=\@Self;
if w1=nil then
exit;
while (w1^.prev<>nil) and not C do
begin
w1:=w1^.prev;
if (w1^.x-x<w) and (x<w1^.x+w1^.w) and
(w1^.y-y<h) and (y<w1^.y+w1^.h) and
(w1<>\@Self) then
C:=true;
end;
Covered:=C;
end;
function Window.Event(mxx,myy:integer;but1,but2,but3:boolean):boolean;
begin
Process(\@Self);
if not drawn then
if (Active=\@Self) then
redraw
else
SetActive;
if ((Active=\@Self) or not Covered) and (Not Fresh) then
begin
if (x-mxx<16-4*(4-(Attr and LockPos))) and (mxx<x+w-1) and
(y-myy<0) and (myy<y+h-1-4*(4-(Attr and LockPos))) then
Hidem;
SetView;
Refresh(\@Self);
SaveSettings;
if (x-mxx<16-4*(4-(Attr and LockPos))) and (mxx<x+w-1) and
(y-myy<0) and (myy<y+h-1-4*(4-(Attr and LockPos))) then
Showm;
end;
Event:=false;
if (mxx>x) and (mxx<x+w-1) and
(myy>y) and (myy<y+h-1) then
begin
event:=true;
if but1 then
begin
if (Active<>\@Self) then
SetActive;
exit;
end;
{ if but2 then
begin
if (Active<>\@Self) then
SetActive;
case Menu(PMenu,mxx,myy) of
0: Done;
end;
exit;
end;}
if (myy<y+15) and (mxx>x+14) and but3 then
begin
if (Active<>\@Self) then
SetActive;
Move;
exit;
end;
if (mxx<x+15) and (myy<y+15) and but3 then
begin
if (attr and LockOpen)<>LockOpen then
Done;
exit;
end;
if (mxx>x) and (myy>y+14) and (myy<y+h-2) and
((attr and LockSize)<>LockSize) and but3 then
begin
if (Active<>\@Self) then
SetActive
else
SetView;
Size;
exit;
end;
event:=false;
end;
end;
procedure Window.DrawAll;
var
w1: windowPtr;
begin
w1:=\@Self;
if w1=nil then exit;
while w1^.next<>nil do
w1:=w1^.next;
while w1<>nil do
begin
w1^.drawn:=false;
w1:=w1^.prev;
end;
end;
procedure Window.DrawCovered;
var
w1: WindowPtr;
begin
if not covering and not covered then
exit;
w1:=\@self;
while w1^.next<>nil do
w1:=w1^.next;
while w1<>nil do
begin
if Covers(w1^) then
begin
w1^.drawn:=false;
end;
if (W1^.Covers(Self)) then
begin
w1^.drawn:=false;
end;
w1:=w1^.prev;
end;
end;
procedure Window.DrawCovering;
var
w1: WindowPtr;
begin
if not covering and not covered then
exit;
w1:=\@self;
while w1^.next<>nil do
w1:=w1^.next;
while w1<>nil do
begin
if (W1^.Covers(Self)) or (covers(w1^)) then
begin
w1^.drawn:=false;
end;
w1:=w1^.prev;
end;
end;
procedure Window.Move;
var
b: boolean;
ox: integer;
oy: integer;
mxx: integer;
myy: integer;
Ln: LineSettingsType;
w2: integer;
h2: integer;
begin
b:=but3;
ox:=mx;
oy:=my;
w2:=w div 2;
h2:=h div 2;
if ox-w2<0 then
ox:=w2;
if ox+w2>MaxX then
ox:=MaxX-w2;
if oy-h2<0 then
oy:=h2;
if oy+h2>MaxY then
oy:=MaxY-h2;
GetLineSettings(Ln);
SetLineStyle(DashedLn,1,1);
SetViewPort(0,0,MaxX,MaxY,true);
SetWriteMode(XorPut);
hidem;
rectangle(ox-w2,oy-h2,ox+w2-1,oy+h2-1);
showm;
repeat
mxx:=mx;
myy:=my;
if mxx-w2<0 then
mxx:=w2;
if mxx+w2>MaxX then
mxx:=MaxX-w2;
if myy-h2<0 then
myy:=h2;
if myy+h2>MaxY then
myy:=MaxY-h2;
if (ox<>mxx) or (oy<>myy) then
begin
hidem;
rectangle(ox-w2,oy-h2,ox+w2-1,oy+h2-1);
rectangle(mxx-w2,myy-h2,mxx+w2-1,myy+h2-1);
showm;
ox:=mxx;
oy:=myy;
end;
until but3<>b;
SetLineStyle(SolidLn,1,1);
setwriteMode(CopyPut);
hidem;
setcolor(0);
setfillstyle(1,0);
bar(x,y,x+w-1,y+h-1);
showm;
DrawCovered;
x:=ox-w2;
y:=oy-h2;
redraw;
SetView;
with Ln do
SetLineStyle(LineStyle,Pattern,Thickness);
Fresh:=false;
end;
procedure Window.Size;
var
b: boolean;
ox: word;
oy: word;
mxx: word;
myy: word;
Vw: ViewPortType;
Ln: LineSettingsType;
begin
b:=but3;
ox:=mx;
oy:=my;
GetLineSettings(Ln);
GetViewSettings(Vw);
SetLineStyle(DashedLn,1,1);
SetViewPort(0,0,MaxX,MaxY,true);
SetWriteMode(XorPut);
hidem;
rectangle(vw.x1,vw.y1,ox,oy);
showm;
repeat
mxx:=mx;
myy:=my;
if mxx<x+80 then
mxx:=x+80;
if myy<y+80 then
myy:=y+80;
if (ox<>mxx) or (oy<>myy) then
begin
hidem;
rectangle(Vw.X1,Vw.y1,ox,oy);
rectangle(Vw.x1,Vw.y1,mxx,myy);
showm;
ox:=mxx;
oy:=myy;
end;
until but3<>b;
SetLineStyle(SolidLn,1,1);
setwriteMode(CopyPut);
hidem;
setcolor(0);
setfillstyle(1,0);
bar(x,y,x+w-1,y+h-1);
showm;
drawCovered;
w:=mxx-x+1;
h:=myy-y+1;
if ((attr and LockPos)<>LockPos) and (y+h-1<MaxY) then
h:=h+15;
redraw;
SetView;
with Ln do
SetLineStyle(LineStyle,Pattern,Thickness);
Fresh:=False;
end;
Function Window.AllClosed:boolean;
var
w1: windowPtr;
begin
AllClosed:=true;
w1:=\@Self;
while (w1<>nil) and ((w1^.attr and LockOpen)=LockOpen) do
w1:=w1^.next;
if w1<>nil then
Allclosed:=false;
end;
procedure Window.Check;
var
W1: WindowPtr;
mxx: integer;
myy: integer;
b1,
b2,
b3: boolean;
begin
b1:=but1;
b2:=but2;
b3:=but3;
mxx:=mx;
myy:=my;
W1:=\@Self;
while (W1<>Nil) and not W1^.Event(mxx,myy,b1,b2,b3) do
W1:=W1^.Next;
end;
procedure Window.SetTitle(T:String);
begin
title:=T;
if Active<>\@Self then
SetActive
else
Redraw;
end;
{$F+}
procedure ProcessClock(C:CapPtr);
var
h,m,s,s100: word;
begin
if not C^.Fresh then
exit;
C^.Fresh:=true;
GetTime(h,m,s,s100);
if (oldMin<>m) or (oldhrs<>h) then
C^.Fresh:=false;
end;
procedure RefreshClock(C:CapPtr);
var
Points: array[0..3] of PointType;
h,m,s,s100: word;
x,y: word;
width: word;
height: word;
Arc1: ArcCoordsType;
Arc2: ArcCoordsType;
A: word;
begin
x:=70;
y:=80;
GetTime(h,m,s,s100);
hidem;
setwritemode(copyput);
setFillStyle(1,7);
setcolor(7);
A:=90-30*oldhrs-oldmin div 2;
Arc(x,y,A-5,A+5,35);
GetArcCoords(Arc1);
Arc(x,y,A-15,A+15,12);
GetArcCoords(Arc2);
with Arc1 do
begin
Points[1].x:=XStart;
Points[1].y:=YStart;
Points[0].x:=XEnd;
Points[0].y:=YEnd;
end;
with Arc2 do
begin
Points[2].x:=XStart;
Points[2].y:=YStart;
Points[3].x:=XEnd;
Points[3].y:=YEnd;
end;
FillPoly(4,Points);
A:=90-6*oldmin;
Arc(x,y,A-5,A+5,45);
GetArcCoords(Arc1);
Arc(x,y,A-10,A+10,12);
GetArcCoords(Arc2);
with Arc1 do
begin
Points[1].x:=XStart;
Points[1].y:=YStart;
Points[0].x:=XEnd;
Points[0].y:=YEnd;
end;
with Arc2 do
begin
Points[2].x:=XStart;
Points[2].y:=YStart;
Points[3].x:=XEnd;
Points[3].y:=YEnd;
end;
FillPoly(4,Points);
oldhrs:=h;
oldmin:=m;
setcolor(8);
SetFillStyle(1,8);
SetTextStyle(TriplexFont,HorizDir,0);
SetTextJustify(CenterText,CenterText);
OutTextXY(x,y-68,'12');
OutTextXY(x+60,y,'3');
OutTextXY(x-60,y,'9');
OutTextXY(x,y+60,'6');
SetColor(15);
Arc(x,y,45,225,49);
Arc(x,y,45,225,10);
SetColor(8);
Arc(x,y,226,44,49);
Arc(x,y,226,44,10);
C^.Fresh:=true;
A:=90-30*oldhrs-oldmin div 2;
Arc(x,y,A-5,A+5,35);
GetArcCoords(Arc1);
Arc(x,y,A-15,A+15,12);
GetArcCoords(Arc2);
with Arc1 do
begin
Points[1].x:=XStart;
Points[1].y:=YStart;
Points[0].x:=XEnd;
Points[0].y:=YEnd;
end;
with Arc2 do
begin
Points[2].x:=XStart;
Points[2].y:=YStart;
Points[3].x:=XEnd;
Points[3].y:=YEnd;
end;
FillPoly(4,Points);
A:=90-6*(oldmin);
Arc(x,y,A-5,A+5,45);
GetArcCoords(Arc1);
Arc(x,y,A-10,A+10,12);
GetArcCoords(Arc2);
with Arc1 do
begin
Points[1].x:=XStart;
Points[1].y:=YStart;
Points[0].x:=XEnd;
Points[0].y:=YEnd;
end;
with Arc2 do
begin
Points[2].x:=XStart;
Points[2].y:=YStart;
Points[3].x:=XEnd;
Points[3].y:=YEnd;
end;
FillPoly(4,Points);
showm;
end;
procedure Close;
begin
Clock.Done;
closeGraph;
restoreCRTMode;
ExitProc:=SavePtr;
end;
{$F-}
Function NewProcess(w,h:integer;A:byte;Proc,Ref:ProcPtr;T:string):byte;
var
c: byte;
begin
for c:=0 to NumCapsules do
if Capsules[c].x=-1 then
begin
Capsules[c].Init((MaxX-w) div 2,(MaxY-h) div 2,w,h,A,'');
Capsules[C].SetTitle(T);
Capsules[C].SetProc(Proc,Ref);
NewProcess:=c;
exit;
end;
halt(50);
end;
Function AllDone:boolean;
begin
AllDone:=Active^.AllClosed;
end;
procedure CheckProcess;
begin
Active^.Check;
end;
function ProcessDone(Cap:byte):boolean;
begin
ProcessDone:=Capsules[cap].x=-1;
end;
Procedure KillProcess(Cap:byte);
begin
Capsules[cap].Done;
Capsules[cap].x:=-1;
end;
var
Ccnt: word;
begin
for ccnt:=0 to NumCapsules do
Capsules[ccnt].x:=-1;
Active:=nil;
SelectColor:=3;
gd:=detect;
initgraph(gd,gm,'/bin/graphics');
gm:=getMaxMode;
initgraph(gd,gm,'/bin/graphics');
Setup;
SetBkColor(0);
InitGm;
if (MaxX<639) or (MaxY<349) then
begin
CloseGraph;
RestoreCRTMode;
writeln('This program requires an EGA, ATT400, MCGA, VGA,');
writeln('or IBM 8514A video adapter card to operate.');
halt(1);
end;
Clock.Init(0,MaxY-176,143,176,LockPos+LockSize+LockOpen,'');
Clock.SetTitle('Clock');
Clock.SetProc(ProcessClock,RefreshClock);
SavePtr:=ExitProc;
ExitProc:=\@Close;
end.
--
Jeff Watkins gt3070b@prism.gatech.edu
"All opinions are mine... so don't even think of keeping some to yourself!"