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 2016-11-01 12:23:58 +00:00
parent 0485fe792b
commit 39f57c29f2
7 changed files with 146 additions and 87 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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.

View File

@ -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.

View File

@ -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