Subversion Repositories Kolibri OS

Rev

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

Rev Author Line No. Line
6613 leency 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.