home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / display.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  16KB  |  316 lines
  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. StampElems
  6. Alloc
  7. 27 May 96
  8. Syntax10b.Scn.Fnt
  9. Syntax10i.Scn.Fnt
  10. (* AMIGA *)
  11. MODULE Display; (* shml/cn 
  12.     IMPORT SYSTEM,Amiga,G:=AmigaGraphics,I:=AmigaIntuition, Pictures;
  13.     CONST
  14.         black* = Pictures.black; white* = Pictures.white;
  15.         replace* = Pictures.replace; (* The new graphical object completely replaces whatever was before in the destination area. *)
  16.         paint* = Pictures.paint; (* The new graphical object is added to whatever was before in the dertination area. *)
  17.         invert* = Pictures.invert; (* The new graphical object inverts whatever was before in the dertination area. The color specifies, which planes are affected (inverted) and which aren't *)
  18.     TYPE
  19.         Type Frame is declared in this module, but not used, except for defining the clipping areas in
  20.         the ...C procedures. It's module Viewer, which actually uses the dsc, next and handle fields.
  21.         So why aren't they part of ViewerDesc?
  22.         X,Y,W and H define the bounding box of a frame.
  23.         Frame* = Pictures.Frame;
  24.         FrameMsg* = Pictures.FrameMsg;
  25.         Handler* = Pictures.Handler;
  26.         FrameDesc* = Pictures.FrameDesc;
  27.         Pattern* = Pictures.Pattern;
  28.         Font* = POINTER TO Bytes;    (*Amiga.Font*)
  29.         Bytes* = RECORD END;
  30.     TYPE
  31.         Location=RECORD offset,width:INTEGER END;
  32.         LocationArray=ARRAY 256 OF Location;
  33.         LocationPtr=POINTER TO LocationArray;
  34.         SpaceArray=ARRAY 256 OF INTEGER;
  35.         SpacePtr=POINTER TO SpaceArray;
  36.         KernArray=ARRAY 256 OF INTEGER;
  37.         KernPtr=POINTER TO KernArray;
  38.         RastPortPtr=POINTER TO G.RastPort;
  39.         ScreenPtr=POINTER TO I.Screen;
  40.         TextFontPtr=POINTER TO G.TextFont;
  41.         WindowPtr=POINTER TO I.Window;
  42.         Unit*: LONGINT; (*RasterUnit = Unit/36000 mm*)
  43.         Left*, ColLeft*, Bottom*, Width*, Height*: INTEGER;
  44.         arrow*, star*, hook*, cross*, downArrow*: Pattern;
  45.         grey0*, grey1*, grey2*, ticks*: Pattern;
  46.         screen-:Pictures.Picture;
  47.         nofCols: INTEGER;
  48.     PROCEDURE NewPattern*(VAR image: ARRAY OF SET; w, h: INTEGER): Pattern;
  49.     (* Allocates a new pattern with width w and height h. The i-th pattern line from bottom (increasing y-value)
  50.         corresponds to the image entries (i+1)*lineLen .. (i+2)*lineLen-1, where lineLen = (w+31) DIV 32.
  51.         The set elements desribe the pixels from left to right (increasing x-value). *)
  52.     BEGIN
  53.         RETURN Pictures.NewPattern(image,w,h)
  54.     END NewPattern;
  55.     (* Get the Address of Video-RAM, not possible at the AMIGA *)
  56.     PROCEDURE Map*(X, Y: INTEGER): LONGINT;
  57.     BEGIN
  58.         RETURN 0
  59.     END Map;
  60.     (* Activate DIsplay, only one Display realized at the moment *)
  61.     PROCEDURE SetMode*(X: INTEGER; s: SET);
  62.     BEGIN
  63.     END SetMode;
  64.     PROCEDURE SetColor*(col, red, green, blue: INTEGER); (*col < 0: overlay color not supported on the Amiga*)
  65.         Set the RGB values for a color.
  66.     BEGIN
  67.         Pictures.SetColor(screen, col, red, green, blue);
  68.         Pictures.SetDisplayColor(col, red, green, blue)
  69.     END SetColor;
  70.     PROCEDURE GetColor*(col: INTEGER; VAR red, green, blue: INTEGER);
  71.         Return the RGB values for a color.
  72.     BEGIN
  73.         Pictures.GetColor(screen, col, red, green, blue)
  74.     END GetColor;
  75.     PROCEDURE GetChar*(f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: Pattern);
  76.         (*get raster data of character ch*)
  77.     VAR charInfo: Amiga.CharInfo; raster: Amiga.Font;
  78.     BEGIN
  79.         raster := SYSTEM.VAL(Amiga.Font, f);
  80.         IF raster.amigaFont#0 THEN
  81.             ch:=Amiga.ConvOtoA(ch)
  82.         END;
  83.         charInfo := raster.info[ORD(ch)];
  84.         dx := charInfo.dx; x := charInfo.x; y := charInfo.y; w := charInfo.w; h := charInfo.h;
  85.         p := SYSTEM.ADR(raster.info[ORD(ch)])
  86.     END GetChar;
  87.     (*raster operations*)
  88.     PROCEDURE CopyBlock*(SX, SY, W, H, DX, DY, mode: INTEGER);
  89.         Copy a rectangular area within the display to another place. This procedure assumes, that any single
  90.         area does not cross the boundary between primary and secondary screen.
  91.     BEGIN
  92.         Pictures.CopyBlock(screen,screen,SX, SY, W, H, DX, DY, mode)
  93.     END CopyBlock;
  94.     PROCEDURE CopyBlockC*(f: Frame; SX, SY, W, H, DX, DY, mode: INTEGER);
  95.         As CopyBlock, but the destination area is clipped against the Frame boundary.
  96.     BEGIN
  97.         Pictures.CopyBlockC(screen,screen,f, SX, SY, W, H, DX, DY, mode)
  98.     END CopyBlockC;
  99.     PROCEDURE CopyPattern*(col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
  100.         Copy a pattern to the specified location.
  101.     BEGIN
  102.         Pictures.CopyPattern(screen, col, pat, X, Y, mode)
  103.     END CopyPattern;
  104.     PROCEDURE CopyPatternC*(f: Frame; col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
  105.         As CopyPattern, but clips the pattern against the frame boundary.
  106.     BEGIN
  107.         Pictures.CopyPatternC(screen, f, col, pat, X, Y, mode)
  108.     END CopyPatternC;
  109.     PROCEDURE ReplPattern*(col: INTEGER; pat: Pattern; X, Y, W, H, mode: INTEGER);
  110.         Fill the specified area with the pattern.
  111.     BEGIN
  112.         Pictures.ReplPattern(screen,col,pat,X,Y,W,H,mode)
  113.     END ReplPattern;
  114.     PROCEDURE ReplPatternC*(f: Frame; col: INTEGER; pat: Pattern; X, Y, W, H, X0, Y0, mode: INTEGER);
  115.         (* Replicates a pattern pat within the block (X, Y, W, H), clipped against F. The pattern origin is X0, Y0; i.e. for each
  116.             completely visible occurrence of the pattern pat the following holds: ((x - X0) MOD w = 0) & ((y-Y0) MOD h = 0)
  117.             where (x, y) denotes the left and bottom corner, and (w, h) the size of the pattern. *)
  118.     BEGIN
  119.         Pictures.ReplPatternC(screen,f,col,pat,X,Y,W,H,X0,Y0,mode)
  120.     END ReplPatternC;
  121.     PROCEDURE ReplConst*(col: INTEGER; X, Y, W, H, mode: INTEGER);
  122.         Generate a rectangle with the specified color and paint mode.
  123.     BEGIN
  124.         Pictures.ReplConst(screen,col,X,Y,W,H,mode)
  125.     END ReplConst;
  126.     PROCEDURE ReplConstC*(f: Frame; col: INTEGER; X, Y, W, H, mode: INTEGER);
  127.         As ReplConst, but the rectangle is clipped against the frame boundary.
  128.     BEGIN
  129.         Pictures.ReplConstC(screen,f,col,X,Y,W,H,mode)
  130.     END ReplConstC;
  131.     PROCEDURE Dot*(col: INTEGER; X, Y, mode: INTEGER);
  132.         Change a single pixel.
  133.     BEGIN
  134.         Pictures.Dot(screen,col,X,Y,mode)
  135.     END Dot;
  136.     PROCEDURE DotC*(f: Frame; col: INTEGER; X, Y, mode: INTEGER);
  137.          As Dot, but the the pixel is only written, if contained within the frame boundary.
  138.     BEGIN
  139.         Pictures.DotC(screen,f,col,X,Y,mode)
  140.     END DotC;
  141.     PROCEDURE InitColors(P: Pictures.Picture);
  142.         Set picture Ps colors to default values
  143.     BEGIN
  144.         Pictures.SetColor(P, 0, 255, 255, 255); Pictures.SetColor(P, 1, 0, 0, 0);
  145.         IF Amiga.OberonDepth>1 THEN
  146.             Pictures.SetColor(P, 1, 255, 0, 0); Pictures.SetColor(P, 2, 0, 0, 255); Pictures.SetColor(P, 3, 0, 0, 0)
  147.         END;
  148.         IF Amiga.OberonDepth>2 THEN
  149.             Pictures.SetColor(P, 2, 0, 255, 0);
  150.             Pictures.SetColor(P, 3, 0, 0, 255); Pictures.SetColor(P, 4, 255, 255, 0); Pictures.SetColor(P, 5, 255, 0, 255);
  151.             Pictures.SetColor(P, 6, 0, 255, 255); Pictures.SetColor(P, 7, 0, 0, 0)
  152.         END;
  153.         IF Amiga.OberonDepth>3 THEN
  154.             Pictures.SetColor(P, 7, 160, 0, 0); Pictures.SetColor(P, 8, 0, 144, 0); Pictures.SetColor(P, 9, 0, 0, 144);
  155.             Pictures.SetColor(P, 10, 112, 0, 192); Pictures.SetColor(P, 11, 230, 230, 230); Pictures.SetColor(P, 12, 210, 210, 210);
  156.             Pictures.SetColor(P, 13, 150, 150, 150); Pictures.SetColor(P, 14, 100, 100, 100); Pictures.SetColor(P, 15, 0, 0, 0)
  157.         END;
  158.         IF Amiga.OberonDepth>4 THEN Pictures.SetColor(P, nofCols-1, 127, 127, 127) END;
  159.     END InitColors;
  160.     PROCEDURE CreatePatterns;
  161.         Create the images for the exported patterns.
  162.         VAR image: ARRAY 17 OF SET; i: INTEGER;
  163.     BEGIN
  164.         IF Amiga.WBWindow THEN
  165.             FOR i:=1 TO 15 DO image[i]:={} END;
  166.         ELSE
  167.             image[1] := {13};
  168.             image[2] := {12..14};
  169.             image[3] := {11..13};
  170.             image[4] := {10..12};
  171.             image[5] := {9..11};
  172.             image[6] := {8..10};
  173.             image[7] := {7..9};
  174.             image[8] := {0, 6..8};
  175.             image[9] := {0, 1, 5..7};
  176.             image[10] := {0..2, 4..6};
  177.             image[11] := {0..5};
  178.             image[12] := {0..4};
  179.             image[13] := {0..5};
  180.             image[14] := {0..6};
  181.             image[15] := {0..7};
  182.         END;
  183.         arrow := NewPattern(image, 15, 15);
  184.         image[1] := {0, 10};
  185.         image[2] := {1, 9};
  186.         image[3] := {2, 8};
  187.         image[4] := {3, 7};
  188.         image[5] := {4, 6};
  189.         image[6] := {};
  190.         image[7] := {4, 6};
  191.         image[8] := {3, 7};
  192.         image[9] := {2, 8};
  193.         image[10] := {1, 9};
  194.         image[11] := {0, 10};
  195.         cross := NewPattern(image,11,11);
  196.         image[1] := {6};
  197.         image[2] := {5..7};
  198.         image[3] := {4..8};
  199.         image[4] := {3..9};
  200.         image[5] := {2..10};
  201.         image[6] := {5..7};
  202.         image[7] := {5..7};
  203.         image[8] := {5..7};
  204.         image[9] := {5..7};
  205.         image[10] := {5..7};
  206.         image[11] := {5..7};
  207.         image[12] := {5..7};
  208.         image[13] := {5..7};
  209.         image[14] := {5..7};
  210.         image[15] := {};
  211.         downArrow := NewPattern(image,15,15);
  212.         image[1] := {0, 4, 8, 12};
  213.         image[2] := {};
  214.         image[3] := {2, 6, 10, 14};
  215.         image[4] := {};
  216.         image[5] := {0, 4, 8, 12};
  217.         image[6] := {};
  218.         image[7] := {2, 6, 10, 14};
  219.         image[8] := {};
  220.         image[9] := {0, 4, 8, 12};
  221.         image[10] := {};
  222.         image[11] := {2, 6, 10, 14};
  223.         image[12] := {};
  224.         image[13] := {0, 4, 8, 12};
  225.         image[14] := {};
  226.         image[15] := {2, 6, 10, 14};
  227.         image[16] := {};
  228.         grey0 := NewPattern(image,16,16);
  229.         image[1] := {0, 2, 4, 6, 8, 10, 12, 14};
  230.         image[2] := {1, 3, 5, 7, 9, 11, 13, 15};
  231.         image[3] := {0, 2, 4, 6, 8, 10, 12, 14};
  232.         image[4] := {1, 3, 5, 7, 9, 11, 13, 15};
  233.         image[5] := {0, 2, 4, 6, 8, 10, 12, 14};
  234.         image[6] := {1, 3, 5, 7, 9, 11, 13, 15};
  235.         image[7] := {0, 2, 4, 6, 8, 10, 12, 14};
  236.         image[8] := {1, 3, 5, 7, 9, 11, 13, 15};
  237.         image[9] := {0, 2, 4, 6, 8, 10, 12, 14};
  238.         image[10] := {1, 3, 5, 7, 9, 11, 13, 15};
  239.         image[11] := {0, 2, 4, 6, 8, 10, 12, 14};
  240.         image[12] := {1, 3, 5, 7, 9, 11, 13, 15};
  241.         image[13] := {0, 2, 4, 6, 8, 10, 12, 14};
  242.         image[14] := {1, 3, 5, 7, 9, 11, 13, 15};
  243.         image[15] := {0, 2, 4, 6, 8, 10, 12, 14};
  244.         image[16] := {1, 3, 5, 7, 9, 11, 13, 15};
  245.         grey1 := NewPattern(image,16,16);
  246.         image[1] := {0, 1, 4, 5, 8, 9, 12, 13};
  247.         image[2] := {0, 1, 4, 5, 8, 9, 12, 13};
  248.         image[3] := {2, 3, 6, 7, 10, 11, 14, 15};
  249.         image[4] := {2, 3, 6, 7, 10, 11, 14, 15};
  250.         image[5] := {0, 1, 4, 5, 8, 9, 12, 13};
  251.         image[6] := {0, 1, 4, 5, 8, 9, 12, 13};
  252.         image[7] := {2, 3, 6, 7, 10, 11, 14, 15};
  253.         image[8] := {2, 3, 6, 7, 10, 11, 14, 15};
  254.         image[9] := {0, 1, 4, 5, 8, 9, 12, 13};
  255.         image[10] := {0, 1, 4, 5, 8, 9, 12, 13};
  256.         image[11] := {2, 3, 6, 7, 10, 11, 14, 15};
  257.         image[12] := {2, 3, 6, 7, 10, 11, 14, 15};
  258.         image[13] := {0, 1, 4, 5, 8, 9, 12, 13};
  259.         image[14] := {0, 1, 4, 5, 8, 9, 12, 13};
  260.         image[15] := {2, 3, 6, 7, 10, 11, 14, 15};
  261.         image[16] := {2, 3, 6, 7, 10, 11, 14, 15};
  262.         grey2 := NewPattern(image,16,16);
  263.         image[1] := {0..7};
  264.         image[2] := {0..6};
  265.         image[3] := {0..5};
  266.         image[4] := {0..4};
  267.         image[5] := {0..3};
  268.         image[6] := {0..2};
  269.         image[7] := {0..1};
  270.         image[8] := {0};
  271.         hook := NewPattern(image,8,8);
  272.         image[1] := {7};
  273.         image[2] := {7};
  274.         image[3] := {2, 7, 12};
  275.         image[4] := {3, 7, 11};
  276.         image[5] := {4, 7, 10};
  277.         image[6] := {5, 7, 9};
  278.         image[7] := {6..8};
  279.         image[8] := {0..6, 8..14};
  280.         image[9] := {6..8};
  281.         image[10] := {5, 7, 9};
  282.         image[11] := {4, 7, 10};
  283.         image[12] := {3, 7, 11};
  284.         image[13] := {2, 7, 12};
  285.         image[14] := {7};
  286.         image[15] := {7};
  287.         star := NewPattern(image,15,15);
  288.         image[1] := {0};
  289.         image[2] := {};
  290.         image[3] := {};
  291.         image[4] := {};
  292.         image[5] := {};
  293.         image[6] := {};
  294.         image[7] := {};
  295.         image[8] := {};
  296.         image[9] := {};
  297.         image[10] := {};
  298.         image[11] := {};
  299.         image[12] := {};
  300.         image[13] := {};
  301.         image[14] := {};
  302.         image[15] := {};
  303.         image[16] := {};
  304.         ticks := NewPattern(image,16,16)
  305.     END CreatePatterns;
  306. BEGIN
  307.     Left := 0; ColLeft := 0; Bottom := 0;
  308.     Width := Amiga.Width; Height := Amiga.Height; Unit := 14000;
  309.     nofCols:=SHORT(ASH(1, Amiga.OberonDepth));
  310.     CreatePatterns;
  311.     Pictures.WindowToPicture(Amiga.window,screen);
  312.     InitColors(screen);
  313.     Pictures.UseOberonColors(screen);
  314.     IF Amiga.WBWindow & Amiga.ModifyColors THEN Amiga.TermProcedure(Pictures.UseBufferedColors) END
  315. END Display.
  316.