home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
modula2
/
compiler
/
fst_mod
/
source
/
windows.mod
< prev
next >
Wrap
Text File
|
1992-06-24
|
10KB
|
421 lines
IMPLEMENTATION MODULE Windows;
FROM SYSTEM IMPORT ASSEMBLER;
FROM Strings IMPORT Length;
FROM Text IMPORT Color, GetKey, Write, SetCursor;
FROM Screen IMPORT SaveScreen, RestoreScreen;
VAR watr:CARDINAL;
current:Window;
PROCEDURE Clw();
VAR up,dn,lf,rt:CARDINAL;
BEGIN
up:=current.t;
dn:=current.b;
lf:=current.l;
rt:=current.r;
ASM
MOV CH,up
MOV CL,lf
MOV DH,dn
MOV DL,rt
MOV BH,watr
XOR AL,AL
MOV AH,6
INT 10H
MOV DH,up
MOV DL,lf
XOR BH,BH
MOV AH,2
INT 10H
END;
END Clw;
PROCEDURE WSetCursor(v,h:CARDINAL);
BEGIN
v:=v+current.t;
h:=h+current.l;
IF v>current.b THEN
v:=current.b;
END; (* if *)
IF h>current.r THEN
h:=current.r;
END;
SetCursor(v,h);
END WSetCursor;
PROCEDURE MakeWindow(v,h,height,width,fcolor,bcolor:CARDINAL;
title:Title; VAR w:Window);
BEGIN
w.t:=v;
w.b:=v+height-1;
w.l:=h;
w.r:=h+width-1;
w.fc:=fcolor;
w.bc:=bcolor;
w.ttl:=title;
END MakeWindow;
PROCEDURE GetAttrib(VAR oatr:CARDINAL);
BEGIN
ASM
LES DI,oatr
XOR BH,BH
MOV AH,8
INT 10H
MOV ES:[DI],AH
END;
END GetAttrib;
PROCEDURE SetWindow(VAR w:Window);
BEGIN
current.t := w.t;
current.b := w.b;
current.l := w.l;
current.r := w.r;
watr := (w.bc MOD 8) * 16 + (w.fc MOD 16);
END SetWindow;
PROCEDURE PutWindow(VAR w:Window);
VAR h,v,f,b,i:CARDINAL;
BEGIN
SetWindow(w);
SaveScreen(w.dat);
(* draw border *)
v:=w.t-1; h:=w.l-1;
SetCursor(24,0);
GetAttrib(i);
f:=i MOD 16;
b:=i DIV 16;
SetCursor(v,h);
Color(w.fc,w.bc);
Write(CHR(201));
IF Length(w.ttl)>0 THEN
Write(CHR(181));
INC(h);
FOR i:=0 TO Length(w.ttl)-1 DO
Write(w.ttl[i]);
INC(h);
END; (* for *)
Write(CHR(198));
INC(h);
END; (* if *)
WHILE h<w.r DO
Write(CHR(205));
INC(h);
END; (* while *)
Write(CHR(187));
FOR v:=w.t TO w.b DO
SetCursor(v,w.l-1);
Write(CHR(186));
SetCursor(v,w.r+1);
Write(CHR(186));
END; (* for *)
SetCursor(w.b+1,w.l-1);
Write(CHR(200));
FOR h:=w.l TO w.r DO
Write(CHR(205));
END; (* for *)
Write(CHR(188));
Clw;
Color(f,b);
END PutWindow;
PROCEDURE RemoveWindow(VAR w:Window);
VAR f,b,i:CARDINAL;
BEGIN
RestoreScreen(w.dat);
END RemoveWindow;
PROCEDURE ScrollUp(count:CARDINAL);
VAR up,dn,lf,rt:CARDINAL;
BEGIN
up:=current.t;
dn:=current.b;
lf:=current.l;
rt:=current.r;
ASM
MOV CH,up
MOV CL,lf
MOV DH,dn
MOV DL,rt
MOV BH,watr
MOV AL,count
MOV AH,6
INT 10H
MOV DH,up
MOV DL,lf
XOR BH,BH
MOV AH,2
INT 10H
END;
END ScrollUp;
PROCEDURE ScrollDown(count:CARDINAL);
VAR up,dn,lf,rt:CARDINAL;
BEGIN
up:=current.t;
dn:=current.b;
lf:=current.l;
rt:=current.r;
ASM
MOV CH,up
MOV CL,lf
MOV DH,dn
MOV DL,rt
MOV BH,watr
MOV AL,count
MOV AH,7
INT 10H
MOV DH,up
MOV DL,lf
XOR BH,BH
MOV AH,2
INT 10H
END;
END ScrollDown;
PROCEDURE WRead(VAR ch:CHAR);
VAR key,scan:CHAR;
BEGIN
GetKey(key,scan);
WWrite(key);
ch:=key;
END WRead;
PROCEDURE WReadCard(VAR n:CARDINAL);
VAR str:ARRAY [0..5] OF CHAR;
i:CARDINAL;
BEGIN
WReadString(str);
n:=0;
IF Length(str) > 0 THEN
FOR i:=0 TO Length(str)-1 DO
IF (str[i] >= '0') AND (str[i] <= '9') THEN
n:=10*n+(ORD(str[i])-ORD('0'));
END; (* if *)
END; (* for *)
END; (* if *)
END WReadCard;
PROCEDURE WReadInt(VAR i:INTEGER);
VAR str:ARRAY [0..6] OF CHAR;
c:CHAR;
x:CARDINAL;
p:INTEGER;
neg:BOOLEAN;
BEGIN
WReadString(str);
neg:=FALSE;
i:=0; p:=0;
IF Length(str) > 0 THEN
x:=0;
IF str[x] = "-" THEN
neg:=TRUE; INC(x);
END; (* if *)
WHILE x < Length(str) DO
IF (str[x] >= '0') AND (str[x] <= '9') THEN
p:=10*p; c:=str[x];
ASM
XOR AX,AX
MOV AL,c
SUB AX,48
ADD p,AX
END;
(* (ORD(str[x])-ORD('0')); *)
END; (* if *)
INC(x);
END; (* while *)
END; (* if *)
IF neg THEN
p:=-1*p;
END; (* if *)
i:=p;
END WReadInt;
PROCEDURE WReadString(VAR str:ARRAY OF CHAR);
VAR i:CARDINAL;
ch,sc:CHAR;
BEGIN
i:=0;
GetKey(ch,sc);
WHILE ch<>CHR(13) DO
IF (sc=CHR(14)) OR (sc=CHR(75)) THEN
IF i>0 THEN
DEC(i);
ASM
MOV AL,8
MOV AH,14
INT 10H
MOV AL,32
MOV AH,14
INT 10H
MOV AL,8
MOV AH,14
INT 10H
END;
END; (* if *)
ELSE
WWrite(ch);
str[i]:=ch;
INC(i);
END; (* if *)
GetKey(ch,sc);
END; (* while *)
str[i]:=CHR(0);
WWriteLn;
END WReadString;
PROCEDURE WWriteString(str:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
IF Length(str) > 0 THEN
FOR i:=0 TO Length(str)-1 DO
WWrite(str[i]);
END; (* for *)
END; (* if *)
END WWriteString;
PROCEDURE WWriteCard(n,lngth:CARDINAL);
VAR buf:ARRAY [1..10] OF CHAR;
ln:CARDINAL;
BEGIN
IF lngth > 10 THEN
lngth:=10;
END; (* if *)
FOR ln:=1 TO 10 DO
buf[ln]:=CHR(0);
END; (* for *)
ln:=lngth;
buf[ln]:='0';
WHILE (n>0) AND (ln>0) DO
buf[ln]:=CHR((n MOD 10) + 48);
n:=n DIV 10;
DEC(ln);
END; (* while *)
FOR n:=1 TO lngth DO
WWrite(buf[n]);
END; (* for *)
END WWriteCard;
PROCEDURE WWriteInt(n:INTEGER; lngth:CARDINAL);
VAR buf:ARRAY [1..10] OF CHAR;
ln,c:CARDINAL;
neg:BOOLEAN;
BEGIN
IF lngth > 10 THEN
lngth:=10;
END; (* if *)
FOR ln:=1 TO 10 DO
buf[ln]:=CHR(0);
END; (* for *)
IF n<0 THEN
neg:=TRUE;
n:=-n;
ELSE
neg:=FALSE;
END; (* if *)
ASM
MOV AX,n
MOV c,AX
END;
ln:=lngth;
buf[ln]:='0';
WHILE (c>0) AND (ln>0) DO
buf[ln]:=CHR((c MOD 10)+48);
c:=c DIV 10;
DEC(ln);
END; (* while *)
IF (ln>0) AND neg THEN
buf[ln]:='-';
DEC(ln);
END; (* if *)
FOR ln:=1 TO lngth DO
WWrite(buf[ln]);
END; (* for *)
END WWriteInt;
PROCEDURE WWrite(ch:CHAR);
VAR rt,dn,lf,up:CARDINAL;
BEGIN
lf:=current.l;
dn:=current.b;
rt:=current.r;
up:=current.t;
ASM
MOV CX,1
MOV BL,watr
XOR BH,BH
MOV AL,ch
MOV AH,9
INT 10H
MOV AH,3
INT 10H
INC DL
MOV CL,DL
XOR CH,CH
CMP CX,rt
JLE SETC
MOV DL,lf
INC DH
MOV CL,DH
CMP CX,dn
JLE SETC
MOV BH,watr
MOV CH,up
MOV CL,lf
MOV DH,dn
MOV DL,rt
MOV AL,1
MOV AH,6
INT 10H
MOV DL,lf
SETC: MOV AH,2
INT 10H
END;
END WWrite;
PROCEDURE WWriteLn();
VAR lf,dn,rt,up:CARDINAL;
BEGIN
lf:=current.l;
dn:=current.b;
rt:=current.r;
up:=current.t;
ASM
XOR BH,BH
MOV AH,3
INT 10H
INC DH
CMP DH,dn
JLE SETC
MOV BH,watr
MOV CH,up
MOV CL,lf
MOV DH,dn
MOV DL,rt
MOV AL,1
MOV AH,6
INT 10H
SETC: MOV DL,lf
MOV AH,2
INT 10H
END;
END WWriteLn;
BEGIN
watr:=7;
current.t:=0;
current.b:=24;
current.l:=0;
current.r:=79;
current.fc:=7;
current.bc:=0;
current.ttl:='';
END Windows.