kolibrios/programs/develop/oberon07/Samples/kfont.ob07

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.