forked from KolibriOS/kolibrios
oberon07/lib/kolibrios:
Args: minor fix API._NEW, KOSAPI.malloc: mem_commit ConsoleLib: add set_title procedure KOSAPI, Debug, Out: optimize for size kfonts: text clipping git-svn-id: svn://kolibrios.org@6647 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov
parent
0485fe792b
commit
39f57c29f2
@ -34,6 +34,14 @@ BEGIN
|
||||
sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F")
|
||||
END zeromem;
|
||||
|
||||
PROCEDURE mem_commit*(adr, size: INTEGER);
|
||||
VAR tmp: INTEGER;
|
||||
BEGIN
|
||||
FOR tmp := adr TO adr + size - 1 BY 4096 DO
|
||||
sys.PUT(tmp, 0)
|
||||
END
|
||||
END mem_commit;
|
||||
|
||||
PROCEDURE strncmp*(a, b, n: INTEGER): INTEGER;
|
||||
VAR A, B: CHAR; Res: INTEGER;
|
||||
BEGIN
|
||||
@ -97,28 +105,37 @@ BEGIN
|
||||
sys.PUT(res, size);
|
||||
INC(res, 4)
|
||||
ELSE
|
||||
temp := 0;
|
||||
IF heap + size >= endheap THEN
|
||||
IF sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
|
||||
heap := sysfunc3(68, 12, HEAP_SIZE);
|
||||
temp := sysfunc3(68, 12, HEAP_SIZE)
|
||||
ELSE
|
||||
temp := 0
|
||||
END;
|
||||
IF temp # 0 THEN
|
||||
mem_commit(temp, HEAP_SIZE);
|
||||
heap := temp;
|
||||
endheap := heap + HEAP_SIZE
|
||||
ELSE
|
||||
heap := 0
|
||||
temp := -1
|
||||
END
|
||||
END;
|
||||
IF heap # 0 THEN
|
||||
IF (heap # 0) & (temp # -1) THEN
|
||||
sys.PUT(heap, size);
|
||||
res := heap + 4;
|
||||
heap := heap + size
|
||||
ELSE
|
||||
endheap := 0;
|
||||
res := 0
|
||||
END
|
||||
END
|
||||
ELSE
|
||||
IF sysfunc2(18, 16) > ASR(size, 10) THEN
|
||||
res := sysfunc3(68, 12, size);
|
||||
sys.PUT(res, size);
|
||||
INC(res, 4)
|
||||
IF res # 0 THEN
|
||||
mem_commit(res, size);
|
||||
sys.PUT(res, size);
|
||||
INC(res, 4)
|
||||
END
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
|
||||
@ -80,7 +80,7 @@ PROCEDURE GetArg*(n: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
VAR i, j, len: INTEGER; c: CHAR;
|
||||
BEGIN
|
||||
j := 0;
|
||||
IF n < argc + 1 THEN
|
||||
IF n < argc THEN
|
||||
len := LEN(s) - 1;
|
||||
i := Params[n, 0];
|
||||
WHILE (j < len) & (i <= Params[n, 1]) DO
|
||||
|
||||
@ -56,6 +56,7 @@ VAR
|
||||
cls* : PROCEDURE [stdcall] ();
|
||||
get_cursor_pos* : PROCEDURE [stdcall] (VAR x, y: INTEGER);
|
||||
set_cursor_pos* : PROCEDURE [stdcall] (x, y: INTEGER);
|
||||
set_title* : PROCEDURE [stdcall] (title: INTEGER);
|
||||
|
||||
PROCEDURE open*(wnd_width, wnd_height, scr_width, scr_height: INTEGER; title: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
@ -94,6 +95,7 @@ BEGIN
|
||||
GetProc(sys.ADR(cls), "con_cls");
|
||||
GetProc(sys.ADR(get_cursor_pos), "con_get_cursor_pos");
|
||||
GetProc(sys.ADR(set_cursor_pos), "con_set_cursor_pos");
|
||||
GetProc(sys.ADR(set_title), "con_set_title");
|
||||
END main;
|
||||
|
||||
BEGIN
|
||||
|
||||
@ -120,7 +120,7 @@ BEGIN
|
||||
Char(0AX)
|
||||
END Ln;
|
||||
|
||||
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);
|
||||
PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER);
|
||||
VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN;
|
||||
BEGIN
|
||||
IF IsNan(x) OR IsInf(x) THEN
|
||||
@ -200,7 +200,7 @@ BEGIN
|
||||
DEC(p)
|
||||
END
|
||||
END
|
||||
END FixReal;
|
||||
END _FixReal;
|
||||
|
||||
PROCEDURE Real*(x: LONGREAL; width: INTEGER);
|
||||
VAR e, n, i: INTEGER; minus: BOOLEAN;
|
||||
@ -241,7 +241,8 @@ BEGIN
|
||||
IF minus THEN
|
||||
x := -x
|
||||
END;
|
||||
FixReal(x, width, width - 3);
|
||||
Realp := Real;
|
||||
_FixReal(x, width, width - 3);
|
||||
Char("E");
|
||||
IF e >= 0 THEN
|
||||
Char("+")
|
||||
@ -259,6 +260,12 @@ BEGIN
|
||||
END
|
||||
END Real;
|
||||
|
||||
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);
|
||||
BEGIN
|
||||
Realp := Real;
|
||||
_FixReal(x, width, p)
|
||||
END FixReal;
|
||||
|
||||
PROCEDURE Open*;
|
||||
TYPE
|
||||
|
||||
@ -282,6 +289,4 @@ BEGIN
|
||||
res := KOSAPI.sysfunc2(70, sys.ADR(info))
|
||||
END Open;
|
||||
|
||||
BEGIN
|
||||
Realp := Real
|
||||
END Debug.
|
||||
END Debug.
|
||||
@ -145,12 +145,28 @@ BEGIN
|
||||
RETURN 0
|
||||
END sysfunc22;
|
||||
|
||||
PROCEDURE mem_commit(adr, size: INTEGER);
|
||||
VAR tmp: INTEGER;
|
||||
BEGIN
|
||||
FOR tmp := adr TO adr + size - 1 BY 4096 DO
|
||||
sys.PUT(tmp, 0)
|
||||
END
|
||||
END mem_commit;
|
||||
|
||||
PROCEDURE [stdcall] malloc*(size: INTEGER): INTEGER;
|
||||
VAR ptr: INTEGER;
|
||||
BEGIN
|
||||
sys.CODE("60"); (* pusha *)
|
||||
size := sysfunc3(68, 12, size);
|
||||
IF sysfunc2(18, 16) > ASR(size, 10) THEN
|
||||
ptr := sysfunc3(68, 12, size);
|
||||
IF ptr # 0 THEN
|
||||
mem_commit(ptr, size)
|
||||
END
|
||||
ELSE
|
||||
ptr := 0
|
||||
END;
|
||||
sys.CODE("61") (* popa *)
|
||||
RETURN size
|
||||
RETURN ptr
|
||||
END malloc;
|
||||
|
||||
PROCEDURE [stdcall] free*(ptr: INTEGER): INTEGER;
|
||||
@ -311,6 +327,7 @@ END dll_Init;
|
||||
PROCEDURE LoadLib*(name: ARRAY OF CHAR): INTEGER;
|
||||
VAR Lib: INTEGER;
|
||||
BEGIN
|
||||
DLL_INIT := dll_Init;
|
||||
Lib := sysfunc3(68, 19, sys.ADR(name[0]));
|
||||
IF Lib # 0 THEN
|
||||
init(Lib)
|
||||
@ -318,6 +335,4 @@ BEGIN
|
||||
RETURN Lib
|
||||
END LoadLib;
|
||||
|
||||
BEGIN
|
||||
DLL_INIT := dll_Init
|
||||
END KOSAPI.
|
||||
@ -115,7 +115,7 @@ BEGIN
|
||||
Char(0AX)
|
||||
END Ln;
|
||||
|
||||
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);
|
||||
PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER);
|
||||
VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN;
|
||||
BEGIN
|
||||
IF IsNan(x) OR IsInf(x) THEN
|
||||
@ -195,7 +195,7 @@ BEGIN
|
||||
DEC(p)
|
||||
END
|
||||
END
|
||||
END FixReal;
|
||||
END _FixReal;
|
||||
|
||||
PROCEDURE Real*(x: LONGREAL; width: INTEGER);
|
||||
VAR e, n, i: INTEGER; minus: BOOLEAN;
|
||||
@ -236,7 +236,8 @@ BEGIN
|
||||
IF minus THEN
|
||||
x := -x
|
||||
END;
|
||||
FixReal(x, width, width - 3);
|
||||
Realp := Real;
|
||||
_FixReal(x, width, width - 3);
|
||||
Char("E");
|
||||
IF e >= 0 THEN
|
||||
Char("+")
|
||||
@ -254,9 +255,13 @@ BEGIN
|
||||
END
|
||||
END Real;
|
||||
|
||||
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);
|
||||
BEGIN
|
||||
Realp := Real;
|
||||
_FixReal(x, width, p)
|
||||
END FixReal;
|
||||
|
||||
PROCEDURE Open*;
|
||||
END Open;
|
||||
|
||||
BEGIN
|
||||
Realp := Real
|
||||
END Out.
|
||||
@ -17,7 +17,7 @@
|
||||
|
||||
MODULE kfonts;
|
||||
|
||||
IMPORT sys := SYSTEM;
|
||||
IMPORT sys := SYSTEM, File, KOSAPI;
|
||||
|
||||
CONST
|
||||
|
||||
@ -49,36 +49,6 @@ TYPE
|
||||
TFont* = POINTER TO TFont_desc;
|
||||
|
||||
|
||||
PROCEDURE [stdcall] LoadFile(file_name: INTEGER; VAR size: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
sys.CODE("53"); (* push ebx *)
|
||||
sys.CODE("6A44"); (* push 68 *)
|
||||
sys.CODE("58"); (* pop eax *)
|
||||
sys.CODE("6A1B"); (* push 27 *)
|
||||
sys.CODE("5B"); (* pop ebx *)
|
||||
sys.CODE("8B4D08"); (* mov ecx, [ebp + 08h] *)
|
||||
sys.CODE("CD40"); (* int 40h *)
|
||||
sys.CODE("8B4D0C"); (* mov ecx, [ebp + 0Ch] *)
|
||||
sys.CODE("8911"); (* mov [ecx], edx *)
|
||||
sys.CODE("5B"); (* pop ebx *)
|
||||
sys.CODE("C9"); (* leave *)
|
||||
sys.CODE("C20800"); (* ret 08h *)
|
||||
RETURN 0
|
||||
END LoadFile;
|
||||
|
||||
PROCEDURE [stdcall] sysfunc3(arg1, arg2, arg3: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
sys.CODE("53"); (* push ebx *)
|
||||
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
|
||||
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
|
||||
sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *)
|
||||
sys.CODE("CD40"); (* int 40h *)
|
||||
sys.CODE("5B"); (* pop ebx *)
|
||||
sys.CODE("C9"); (* leave *)
|
||||
sys.CODE("C20C00"); (* ret 0Ch *)
|
||||
RETURN 0
|
||||
END sysfunc3;
|
||||
|
||||
PROCEDURE [stdcall] zeromem(size, adr: INTEGER);
|
||||
BEGIN
|
||||
sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F")
|
||||
@ -260,13 +230,13 @@ BEGIN
|
||||
xsize := glyph.xsize;
|
||||
xmax := x0 + xsize;
|
||||
mem := Font.mem + glyph.base;
|
||||
getrgb(color, r0, g0, b0);
|
||||
FOR i := mem TO mem + xsize * Font.height - 1 DO
|
||||
sys.GET(i, ch);
|
||||
IF ch = 1X THEN
|
||||
pset(buf, x, y, color, bpp32)
|
||||
pset(buf, x, y, color, bpp32);
|
||||
ELSIF (ch = 2X) & smoothing THEN
|
||||
getrgb(pget(buf, x, y, bpp32), r, g, b);
|
||||
getrgb(color, r0, g0, b0);
|
||||
r := (r * 3 + r0) DIV 4;
|
||||
g := (g * 3 + g0) DIV 4;
|
||||
b := (b * 3 + b0) DIV 4;
|
||||
@ -289,31 +259,6 @@ BEGIN
|
||||
END
|
||||
END hline;
|
||||
|
||||
PROCEDURE TextOut*(Font: TFont; canvas, x, y, str, length, color, params: INTEGER);
|
||||
VAR width: INTEGER; c: CHAR; bpp32, smoothing: BOOLEAN;
|
||||
BEGIN
|
||||
IF Font # NIL THEN
|
||||
smoothing := 4 IN BITS(params);
|
||||
bpp32 := 5 IN BITS(params);
|
||||
sys.GET(str, c);
|
||||
WHILE (length > 0) OR (length = -1) & (c # 0X) DO
|
||||
INC(str);
|
||||
width := OutChar(Font^, ORD(c), x, y, canvas, bpp32, smoothing, color, params);
|
||||
IF 3 IN BITS(params) THEN
|
||||
hline(canvas, x + ORD(1 IN BITS(params)) * ((Font.height DIV 2) DIV 3), y + Font.height DIV 2, width, color, bpp32)
|
||||
END;
|
||||
IF 2 IN BITS(params) THEN
|
||||
hline(canvas, x, y + Font.height - 1, width, color, bpp32)
|
||||
END;
|
||||
x := x + width;
|
||||
IF length > 0 THEN
|
||||
DEC(length)
|
||||
END;
|
||||
sys.GET(str, c)
|
||||
END
|
||||
END
|
||||
END TextOut;
|
||||
|
||||
PROCEDURE TextWidth*(Font: TFont; str, length, params: INTEGER): INTEGER;
|
||||
VAR res: INTEGER; c: CHAR;
|
||||
BEGIN
|
||||
@ -327,7 +272,9 @@ BEGIN
|
||||
IF length > 0 THEN
|
||||
DEC(length)
|
||||
END;
|
||||
sys.GET(str, c)
|
||||
IF length # 0 THEN
|
||||
sys.GET(str, c)
|
||||
END
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
@ -344,6 +291,74 @@ BEGIN
|
||||
RETURN res
|
||||
END TextHeight;
|
||||
|
||||
PROCEDURE TextClipLeft(Font: TFont; str, length, params: INTEGER; VAR x: INTEGER): INTEGER;
|
||||
VAR x1: INTEGER; c: CHAR;
|
||||
BEGIN
|
||||
params := params MOD 4;
|
||||
sys.GET(str, c);
|
||||
WHILE (length > 0) OR (length = -1) & (c # 0X) DO
|
||||
INC(str);
|
||||
x1 := x;
|
||||
x := x + Font.glyphs[params, ORD(c)].width;
|
||||
IF x > 0 THEN
|
||||
length := 0;
|
||||
END;
|
||||
IF length > 0 THEN
|
||||
DEC(length)
|
||||
END;
|
||||
IF length # 0 THEN
|
||||
sys.GET(str, c)
|
||||
END
|
||||
END;
|
||||
x := x1
|
||||
RETURN str - 1
|
||||
END TextClipLeft;
|
||||
|
||||
PROCEDURE TextOut*(Font: TFont; canvas, x, y, str, length, color, params: INTEGER);
|
||||
VAR width, xsize, ysize, str1, n: INTEGER; c: CHAR; bpp32, smoothing, underline, strike: BOOLEAN;
|
||||
BEGIN
|
||||
IF Font # NIL THEN
|
||||
sys.GET(canvas, xsize);
|
||||
sys.GET(canvas + 4, ysize);
|
||||
IF (y <= -TextHeight(Font)) OR (y >= ysize) THEN
|
||||
length := 0
|
||||
END;
|
||||
IF length # 0 THEN
|
||||
smoothing := 4 IN BITS(params);
|
||||
bpp32 := 5 IN BITS(params);
|
||||
underline := 2 IN BITS(params);
|
||||
strike := 3 IN BITS(params);
|
||||
str1 := TextClipLeft(Font, str, length, params, x);
|
||||
n := str1 - str;
|
||||
str := str1;
|
||||
IF length >= n THEN
|
||||
length := length - n
|
||||
END;
|
||||
sys.GET(str, c)
|
||||
END;
|
||||
WHILE (length > 0) OR (length = -1) & (c # 0X) DO
|
||||
INC(str);
|
||||
width := OutChar(Font^, ORD(c), x, y, canvas, bpp32, smoothing, color, params);
|
||||
IF strike THEN
|
||||
hline(canvas, x + ORD(1 IN BITS(params)) * ((Font.height DIV 2) DIV 3), y + Font.height DIV 2, width + 2, color, bpp32)
|
||||
END;
|
||||
IF underline THEN
|
||||
hline(canvas, x, y + Font.height - 1, width + 2, color, bpp32)
|
||||
END;
|
||||
x := x + width;
|
||||
IF x > xsize THEN
|
||||
length := 0
|
||||
END;
|
||||
IF length > 0 THEN
|
||||
DEC(length)
|
||||
END;
|
||||
IF length # 0 THEN
|
||||
sys.GET(str, c)
|
||||
END
|
||||
END
|
||||
END
|
||||
END TextOut;
|
||||
|
||||
PROCEDURE SetSize*(_Font: TFont; font_size: INTEGER): BOOLEAN;
|
||||
VAR temp, offset, fsize, i, memsize, mem: INTEGER;
|
||||
c: CHAR; Font, Font2: TFont_desc;
|
||||
@ -381,10 +396,10 @@ BEGIN
|
||||
Font.mempos := 0;
|
||||
memsize := (Font.width + 10) * Font.height * 1024;
|
||||
mem := Font.mem;
|
||||
Font.mem := sysfunc3(68, 12, memsize);
|
||||
Font.mem := KOSAPI.sysfunc3(68, 12, memsize);
|
||||
IF Font.mem # 0 THEN
|
||||
IF mem # 0 THEN
|
||||
mem := sysfunc3(68, 13, mem)
|
||||
mem := KOSAPI.sysfunc3(68, 13, mem)
|
||||
END;
|
||||
zeromem(memsize DIV 4, Font.mem);
|
||||
FOR i := 0 TO 255 DO
|
||||
@ -441,10 +456,10 @@ PROCEDURE Destroy*(VAR Font: TFont);
|
||||
BEGIN
|
||||
IF Font # NIL THEN
|
||||
IF Font.mem # 0 THEN
|
||||
Font.mem := sysfunc3(68, 13, Font.mem)
|
||||
Font.mem := KOSAPI.sysfunc3(68, 13, Font.mem)
|
||||
END;
|
||||
IF Font.data # 0 THEN
|
||||
Font.data := sysfunc3(68, 13, Font.data)
|
||||
Font.data := KOSAPI.sysfunc3(68, 13, Font.data)
|
||||
END;
|
||||
DISPOSE(Font)
|
||||
END
|
||||
@ -453,7 +468,7 @@ END Destroy;
|
||||
PROCEDURE LoadFont*(file_name: ARRAY OF CHAR): TFont;
|
||||
VAR Font: TFont; data, size, n: INTEGER;
|
||||
BEGIN
|
||||
data := LoadFile(sys.ADR(file_name[0]), size);
|
||||
data := File.Load(file_name, size);
|
||||
IF (data # 0) & (size > 156) THEN
|
||||
NEW(Font);
|
||||
Font.data := data;
|
||||
@ -468,7 +483,7 @@ BEGIN
|
||||
END
|
||||
ELSE
|
||||
IF data # 0 THEN
|
||||
data := sysfunc3(68, 13, data)
|
||||
data := KOSAPI.sysfunc3(68, 13, data)
|
||||
END;
|
||||
Font := NIL
|
||||
END
|
||||
|
||||
Loading…
Reference in New Issue
Block a user