diff --git a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 index 1d27b1c24e..70f1bd52f0 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 @@ -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 diff --git a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 index d3bfcb1312..e7cf4bab2a 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 @@ -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 diff --git a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 index a9a76fffb7..85ac6def5e 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 @@ -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 diff --git a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 index a376a11c54..dded894dd9 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 @@ -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. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 index 06f2fcf802..0c000b74a0 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 @@ -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. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 index 5549c5a6e1..e136c01e70 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 @@ -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. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 index 165c093a4d..e699b741bc 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 @@ -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