Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. MODULE RasterW;
  2.  
  3. IMPORT sys := SYSTEM, RW := RasterWorks, KOSAPI;
  4.  
  5.  
  6. TYPE
  7.  
  8.   TWindow = RECORD
  9.  
  10.     Left, Top, Width, Height: INTEGER;
  11.     Color: INTEGER;
  12.     Header: ARRAY 256 OF CHAR
  13.  
  14.   END;
  15.  
  16.  
  17. VAR
  18.  
  19.   canvas : INTEGER;
  20.   bpp32  : BOOLEAN;
  21.  
  22.  
  23. PROCEDURE CreateCanvas(width, height: INTEGER; bpp32: BOOLEAN): INTEGER;
  24. VAR canvas: INTEGER;
  25. BEGIN
  26.   canvas := KOSAPI.malloc(width * height * (3 + ORD(bpp32)) + 8);
  27.   sys.PUT(canvas, width);
  28.   sys.PUT(canvas + 4, height)
  29.   RETURN canvas
  30. END CreateCanvas;
  31.  
  32.  
  33. PROCEDURE ClearCanvas(canvas, color: INTEGER; bpp32: BOOLEAN);
  34. VAR data, width, height, i: INTEGER;
  35. BEGIN
  36.   sys.GET(canvas, width);
  37.   sys.GET(canvas + 4, height);
  38.   data := canvas + 8;
  39.   IF bpp32 THEN
  40.     FOR i := 1 TO width * height DO
  41.       sys.PUT(data, color); INC(data, 4)
  42.     END
  43.   ELSE
  44.     FOR i := 1 TO width * height - 1 DO
  45.       sys.PUT(data, color); INC(data, 3)
  46.     END;
  47.     sys.MOVE(sys.ADR(color), data, 3)
  48.   END
  49. END ClearCanvas;
  50.  
  51.  
  52. PROCEDURE WindowRedrawStatus(p: INTEGER);
  53. VAR aux: INTEGER;
  54. BEGIN
  55.   aux := KOSAPI.sysfunc2(12, p)
  56. END WindowRedrawStatus;
  57.  
  58.  
  59. PROCEDURE DefineAndDrawWindow(x, y, width, height, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR);
  60. VAR aux: INTEGER;
  61. BEGIN
  62.   aux := KOSAPI.sysfunc6(0, x * 65536 + width, y * 65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), sys.ADR(htext[0]))
  63. END DefineAndDrawWindow;
  64.  
  65.  
  66. PROCEDURE WaitForEvent(): INTEGER;
  67.   RETURN KOSAPI.sysfunc1(10)
  68. END WaitForEvent;
  69.  
  70.  
  71. PROCEDURE ExitApp;
  72. VAR aux: INTEGER;
  73. BEGIN
  74.   aux := KOSAPI.sysfunc1(-1)
  75. END ExitApp;
  76.  
  77.  
  78. PROCEDURE DrawCanvas(canvas: INTEGER; x, y: INTEGER; bpp32: BOOLEAN);
  79. VAR xsize, ysize, aux: INTEGER;
  80. BEGIN
  81.   sys.GET(canvas,     xsize);
  82.   sys.GET(canvas + 4, ysize);
  83.   aux := KOSAPI.sysfunc7(65, canvas + 8, xsize * 65536 + ysize, x * 65536 + y, 24 + 8 * ORD(bpp32), 0, 0)
  84. END DrawCanvas;
  85.  
  86.  
  87. PROCEDURE TextOut(canvas, x, y: INTEGER; string: ARRAY OF CHAR; color, params: INTEGER);
  88. VAR width: INTEGER;
  89. BEGIN
  90.   width := RW.drawText(canvas, x, y, sys.ADR(string[0]), LENGTH(string), color + 0FF000000H, params)
  91. END TextOut;
  92.  
  93.  
  94. PROCEDURE DrawText;
  95. VAR x, y: INTEGER;
  96. BEGIN
  97.   ClearCanvas(canvas, 00FFFFFFH, bpp32);
  98.  
  99.   x := 0; y := 0;
  100.  
  101.   TextOut(canvas,  x,  y,  "font size 16",    000000FFH,  RW.params(  16,  0,  RW.cp866,  RW.bpp32 * ORD(bpp32)                     ) );
  102.         y := y + 16;
  103.         x := x + 20;
  104.   TextOut(canvas,  x,  y,  "font size 12",    00FF0000H,  RW.params(  12,  0,  RW.cp866,  RW.bpp32 * ORD(bpp32)                     ) );
  105.         y := y + 12;
  106.         x := x + 20;
  107.   TextOut(canvas,  x,  y,  "italic",          00808080H,  RW.params(  16,  0,  RW.cp866,  RW.bpp32 * ORD(bpp32) + RW.italic         ) );
  108.         y := y + 16;
  109.         x := x + 20;
  110.   TextOut(canvas,  x,  y,  "bold",            00000000H,  RW.params(  16,  0,  RW.cp866,  RW.bpp32 * ORD(bpp32) + RW.bold           ) );
  111.         y := y + 16;
  112.         x := x + 20;
  113.   TextOut(canvas,  x,  y,  "underline",       00000000H,  RW.params(  16,  0,  RW.cp866,  RW.bpp32 * ORD(bpp32) + RW.underline      ) );
  114.         y := y + 16;
  115.         x := x + 20;
  116.   TextOut(canvas,  x,  y,  "strike-through",  00000000H,  RW.params(  16,  0,  RW.cp866,  RW.bpp32 * ORD(bpp32) + RW.strike_through ) );
  117.         y := y + 16;
  118.         x := x + 20;
  119.  
  120.   DrawCanvas(canvas, 10, 10, bpp32);
  121. END DrawText;
  122.  
  123.  
  124. PROCEDURE draw_window(Window: TWindow);
  125. BEGIN
  126.   WindowRedrawStatus(1);
  127.   DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, Window.Color, 51, 0, 0, Window.Header);
  128.   DrawText;
  129.   WindowRedrawStatus(2);
  130. END draw_window;
  131.  
  132.  
  133. PROCEDURE main;
  134. VAR Window: TWindow;
  135. BEGIN
  136.  
  137.   Window.Left   := 200;
  138.   Window.Top    := 200;
  139.   Window.Width  := 400;
  140.   Window.Height := 300;
  141.   Window.Color  := 00C0C0C0H;
  142.   Window.Header := "RasterWorks";
  143.  
  144.   bpp32 := FALSE;
  145.   canvas := CreateCanvas(Window.Width - 30, Window.Height - 50, bpp32);
  146.  
  147.   WHILE TRUE DO
  148.     CASE WaitForEvent() OF
  149.     |1: draw_window(Window)
  150.     |3: ExitApp
  151.     ELSE
  152.     END
  153.   END
  154.  
  155. END main;
  156.  
  157. BEGIN
  158.   main
  159. END RasterW.