home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
display1.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
4KB
|
108 lines
Syntax10.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
StampElems
Alloc
14 Feb 96
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
(* AMIGA *)
MODULE Display1; (* RC 11.12.92, cn
IMPORT
SYSTEM, Amiga,Display,Pictures;
CONST
white = 0; grey1 = 1; grey2 = 2; grey3 = 3; grey4 = 4; black = 5;
texture0 = 6; texture1 = 7; texture2 = 8; texture3 = 9;
scrPat: ARRAY 10 OF LONGINT;
PROCEDURE GetPatternSize*(pat: Display.Pattern; VAR w, h: INTEGER);
(* Returns the pattern size. *)
VAR p: Amiga.PatternInfoPtr;
BEGIN p := SYSTEM.VAL(Amiga.PatternInfoPtr, pat); w := p.w; h := p.h
END GetPatternSize;
PROCEDURE ThisPattern*(n: INTEGER): Display.Pattern;
(* Returns the n-th predefined pattern (corresponding to the printer patterns). If the pattern is not available,
0 is returned. n must be >= 0. Currently 10 patterns are predefined (0 .. 9). *)
BEGIN
IF n >= LEN(scrPat) THEN RETURN 0
ELSE RETURN scrPat[n]
END
END ThisPattern;
PROCEDURE Line*(f: Display.Frame; col, X0, Y0, X1, Y1, mode: INTEGER);
(* Draws a line from (X0, Y0) to (X1, Y1) inclusive, clipped against F. For all line points (x, y) the following holds
always: (min(X0, X1) <= x) & (x <= max(X0, X1) & (min(Y0, Y0) <= y) & (y <= max(Y0, Y1). *)
BEGIN
Pictures.Line(Display.screen,f,col,X0,Y0,X1,Y1,mode)
END Line;
PROCEDURE Ellipse*(f: Display.Frame; col, X, Y, A, B, mode: INTEGER);
(* Draws an ellipse with center (X, Y) and radii A and B, clipped against F. For all ellipse points (x, y) the following holds
always: (X-A <= x) & (x < X+A) & (Y-B <= y) & (y < Y+B). When A = B the resulting ellipse has the same shape
as the corresponding circle with R = A. *)
BEGIN
Pictures.Ellipse(Display.screen,f,col,X,Y,A,B,mode)
END Ellipse;
PROCEDURE Circle*(f: Display.Frame; col, X, Y, R, mode: INTEGER);
(* Draws a circle with center (X, Y) and radius R, clipped against F. For all circle points (x, y) the following holds always:
(X-R <= x) & (x < X+R) & (Y-R <= y) & (y < Y+R). *)
BEGIN
Pictures.Circle(Display.screen,f,col,X,Y,R,mode)
END Circle;
PROCEDURE Init;
VAR image: ARRAY 17 OF SET;
PROCEDURE Repl(step: INTEGER);
VAR i: INTEGER;
BEGIN i := step;
WHILE i < 16 DO image[i+1] := image[i-step+1]; INC(i) END
END Repl;
BEGIN
(*-- initialize screen patterns ---*)
image[1] := {};
Repl(1);
scrPat[white] := Display.NewPattern(image, 16, 16);
image[4] := {0, 8};
image[3] := {};
image[2] := {4, 12};
image[1] := {};
Repl(4);
scrPat[grey1] := Display.NewPattern(image, 16, 16);
image[2] := {0, 4, 8, 12};
image[1] := {2, 6, 10, 14};
Repl(2);
scrPat[grey2] := Display.NewPattern(image, 16, 16);
image[1] := {0, 2, 4, 6, 8, 10, 12, 14};
image[0] := {1, 3, 5, 7, 9, 11, 13, 15};
Repl(2);
scrPat[grey3] := Display.NewPattern(image, 16, 16);
image[2] := {1..3, 5..7, 9..11, 13..15};
image[1] := {0, 1, 3..5, 7..9, 11..13, 15};
Repl(2);
scrPat[grey4] := Display.NewPattern(image, 16, 16);
image[1] := {0..15};
Repl(1);
scrPat[black] := Display.NewPattern(image, 16, 16);
image[4] :={3, 7, 11, 15};
image[3] :={2, 6, 10, 14};
image[2] :={1, 5, 9, 13};
image[1] :={0, 4, 8, 12};
Repl(4);
scrPat[texture0] := Display.NewPattern(image, 16, 16);
image[4] :={0, 4, 8, 12};
image[3] :={1, 5, 9, 13};
image[2] :={2, 6, 10, 14};
image[1] :={3, 7, 11, 15};
Repl(4);
scrPat[texture1] := Display.NewPattern(image, 16, 16);
image[1] := {2, 6, 10, 14};
Repl(1);
scrPat[texture2] := Display.NewPattern(image, 16, 16);
image[4] := {};
image[3] := {};
image[2] := {};
image[1] := {0..15};
Repl(4);
scrPat[texture3] := Display.NewPattern(image, 16, 16)
END Init;
BEGIN
Init
END Display1.