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

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);
+      IF res # 0 THEN
+	mem_commit(res, size);
 	sys.PUT(res, size);
 	INC(res, 4)
+      END
     ELSE
       res := 0
     END

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

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

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.

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.

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.

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,9 +272,11 @@ BEGIN
       IF length > 0 THEN
 	DEC(length)
       END;
+      IF length # 0 THEN
 	sys.GET(str, c)
       END
     END
+  END
   RETURN res
 END TextWidth;
 
@@ -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