MODULE kfont; IMPORT sys := SYSTEM, kfonts, KOSAPI; CONST FileName = "/rd/1/fonts/tahoma.kf"; TYPE TWindow = RECORD Left, Top, Width, Height: INTEGER; Color: INTEGER; Header: ARRAY 256 OF CHAR END; VAR canvas : INTEGER; bpp32 : BOOLEAN; Font12, Font16: kfonts.TFont; PROCEDURE CreateCanvas(width, height: INTEGER; bpp32: BOOLEAN): INTEGER; VAR canvas: INTEGER; BEGIN canvas := KOSAPI.malloc(width * height * (3 + ORD(bpp32)) + 8); sys.PUT(canvas, width); sys.PUT(canvas + 4, height) RETURN canvas END CreateCanvas; PROCEDURE ClearCanvas(canvas, color: INTEGER; bpp32: BOOLEAN); VAR data, width, height, i: INTEGER; BEGIN sys.GET(canvas, width); sys.GET(canvas + 4, height); data := canvas + 8; IF bpp32 THEN FOR i := 1 TO width * height DO sys.PUT(data, color); INC(data, 4) END ELSE FOR i := 1 TO width * height - 1 DO sys.PUT(data, color); INC(data, 3) END; sys.MOVE(sys.ADR(color), data, 3) END END ClearCanvas; PROCEDURE WindowRedrawStatus(p: INTEGER); VAR aux: INTEGER; BEGIN aux := KOSAPI.sysfunc2(12, p) END WindowRedrawStatus; PROCEDURE DefineAndDrawWindow(x, y, width, height, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR); VAR aux: INTEGER; BEGIN aux := KOSAPI.sysfunc6(0, x * 65536 + width, y * 65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), sys.ADR(htext[0])) END DefineAndDrawWindow; PROCEDURE WaitForEvent(): INTEGER; RETURN KOSAPI.sysfunc1(10) END WaitForEvent; PROCEDURE ExitApp; VAR aux: INTEGER; BEGIN aux := KOSAPI.sysfunc1(-1) END ExitApp; PROCEDURE DrawCanvas(canvas: INTEGER; x, y: INTEGER; bpp32: BOOLEAN); VAR xsize, ysize, aux: INTEGER; BEGIN sys.GET(canvas, xsize); sys.GET(canvas + 4, ysize); aux := KOSAPI.sysfunc7(65, canvas + 8, xsize * 65536 + ysize, x * 65536 + y, 24 + 8 * ORD(bpp32), 0, 0) END DrawCanvas; PROCEDURE DrawText; VAR x, y: INTEGER; BEGIN ClearCanvas(canvas, 00FFFFFFH, bpp32); x := 0; y := 0; kfonts.TextOut(Font16, canvas, x, y, sys.ADR("font size 16"), -1, 000000FFH, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing ); y := y + kfonts.TextHeight( Font16 ); x := x + 20; kfonts.TextOut(Font12, canvas, x, y, sys.ADR("font size 12"), -1, 00FF0000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing ); y := y + kfonts.TextHeight( Font12 ); x := x + 20; kfonts.TextOut(Font16, canvas, x, y, sys.ADR("italic"), -1, 00808080H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.italic ); y := y + kfonts.TextHeight( Font16 ); x := x + 20; kfonts.TextOut(Font16, canvas, x, y, sys.ADR("bold"), -1, 00000000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.bold ); y := y + kfonts.TextHeight( Font16 ); x := x + 20; kfonts.TextOut(Font16, canvas, x, y, sys.ADR("underline"), -1, 00000000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.underline ); y := y + kfonts.TextHeight( Font16 ); x := x + 20; kfonts.TextOut(Font16, canvas, x, y, sys.ADR("strike-through"), -1, 00000000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.strike_through ); y := y + kfonts.TextHeight( Font16 ); x := x + 20; DrawCanvas(canvas, 10, 10, bpp32); END DrawText; PROCEDURE draw_window(Window: TWindow); BEGIN WindowRedrawStatus(1); DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, Window.Color, 51, 0, 0, Window.Header); DrawText; WindowRedrawStatus(2); END draw_window; PROCEDURE main; VAR Window: TWindow; bool: BOOLEAN; BEGIN Window.Left := 200; Window.Top := 200; Window.Width := 400; Window.Height := 300; Window.Color := 00C0C0C0H; Window.Header := "kfonts"; bpp32 := TRUE; canvas := CreateCanvas(Window.Width - 30, Window.Height - 50, bpp32); Font12 := kfonts.LoadFont(FileName); IF kfonts.Enabled(Font12, 12) THEN bool := kfonts.SetSize(Font12, 12) END; Font16 := kfonts.LoadFont(FileName); IF kfonts.Enabled(Font16, 16) THEN bool := kfonts.SetSize(Font16, 16) END; WHILE TRUE DO CASE WaitForEvent() OF |1: draw_window(Window) |3: ExitApp ELSE END END END main; BEGIN main END kfont.