Sfoglia il codice sorgente

Module Graph: Types Font and MonoFont; Module Texts

Arthur Yefimov 3 anni fa
parent
commit
09f826a79a
5 ha cambiato i file con 350 aggiunte e 101 eliminazioni
  1. 241 96
      src/Graph.Mod
  2. 13 1
      src/SDL2.Mod
  3. 2 2
      src/Terminal.Mod
  4. 86 0
      src/Texts.Mod
  5. 8 2
      src/make.sh

+ 241 - 96
src/Graph.Mod

@@ -16,13 +16,14 @@ GNU General Public License for more details.
 You should have received a copy of the GNU General Public License
 along with Foobar.  If not, see <http://www.gnu.org/licenses/>.
 *)
-IMPORT SDL := SDL2, SYSTEM, Platform, Out, Utf8;
+IMPORT SDL := SDL2, SYSTEM, Platform, Out, Utf8, Strings, Texts;
 
 CONST
   (* Flip Flags *)
   flipNone* = {};
   flipH*    = 0;
   flipV*    = 1;
+  flipHV*   = flipH + flipV;
 
   (* Draw Mode Flags *)
   drawSpriteNormal* = 0;
@@ -55,9 +56,6 @@ CONST
   btnRight* = 1;
   btnMid*   = 2;
 
-  (* Random Modulo *)
-  randomModulo* = 2147483647; (* =2^31-1 *)
-
   (* Key Codes *)
   kA*           = 4;
   kB*           = 5;
@@ -199,14 +197,26 @@ TYPE
     w*, h*: INTEGER
   END;
 
-  Font* = POINTER TO FontDesc;
-  FontDesc* = RECORD
+  MonoFont* = POINTER TO MonoFontDesc;
+  MonoFontDesc* = RECORD
     bmp*: Bitmap;
     charW*, charH*: INTEGER;
     charRows*, charsInRow*: INTEGER;
     sprites*: POINTER TO ARRAY OF ARRAY OF SDL.Rect
   END;
 
+  CharGeo* = RECORD
+    w*, x*, y*: INTEGER
+  END;
+
+  Font* = POINTER TO FontDesc;
+  FontDesc* = RECORD
+    bmp*: Bitmap;
+    geo*: ARRAY 512 OF CharGeo;
+    geoCount*: INTEGER;
+    h*: INTEGER
+  END;
+
   KeyArray = SDL.KeyArray;
 
   Key* = RECORD
@@ -256,6 +266,7 @@ VAR
   buffer: Bitmap;
   lastFlip: INTEGER;
   frames, framesT: INTEGER;
+  screenAlpha: INTEGER;
 
   (* Flip Region *)
   flipRegion: Region;
@@ -271,13 +282,11 @@ VAR
   mousePointer: Bitmap;
   underMouse: Bitmap; (* Buffer to copy part of image under the mouse *)
 
-  randomSeed-: INTEGER;
-
 PROCEDURE -AAIncludeSDL2h0 '#include "SDL2.h0"';
 
 (* General *)
 
-PROCEDURE GetError*(VAR s: ARRAY OF CHAR);
+PROCEDURE GetError*(OUT s: ARRAY OF CHAR);
 TYPE P = POINTER TO ARRAY 2048 OF SHORTCHAR;
 VAR p: P;
 BEGIN p := SYSTEM.VAL(P, SDL.GetError()); Utf8.Decode(p^, s)
@@ -356,6 +365,14 @@ BEGIN
   b := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET32, SYSTEM.LSH(color, -16)) * {0..7})
 END ColorToRGB;
 
+PROCEDURE ColorToRGBA*(color: INTEGER; VAR r, g, b, a: INTEGER);
+BEGIN
+  r := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET32, color) * {0..7});
+  g := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET32, SYSTEM.LSH(color, -8)) * {0..7});
+  b := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET32, SYSTEM.LSH(color, -16)) * {0..7});
+  a := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET32, SYSTEM.LSH(color, -24)) * {0..7})
+END ColorToRGBA;
+
 PROCEDURE BmpCol*(bmp: Bitmap; r, g, b: INTEGER): INTEGER;
 BEGIN RETURN SDL.MapRGB(bmp.surface.format, SHORT(r), SHORT(g), SHORT(b))
 END BmpCol;
@@ -404,6 +421,14 @@ BEGIN
   END
 END PutPixel;
 
+PROCEDURE GetPixelFast*(bmp: Bitmap; x, y: INTEGER): INTEGER;
+VAR color: INTEGER;
+  n: ADRINT;
+BEGIN n := SYSTEM.VAL(ADRINT, bmp.surface.pixels);
+  INC(n, (y * bmp.w + x) * 4);
+  SYSTEM.GET(n, color) ;
+RETURN color END GetPixelFast;
+
 PROCEDURE GetPixel*(bmp: Bitmap; x, y: INTEGER): INTEGER;
 VAR color: INTEGER;
   n: ADRINT;
@@ -561,26 +586,27 @@ PROCEDURE DestroyBitmap*(bmp: Bitmap);
 BEGIN SDL.FreeSurface(bmp.surface)
 END DestroyBitmap;
 
-PROCEDURE LoadBitmap*(filename: ARRAY OF CHAR): Bitmap;
+PROCEDURE LoadBitmap*(IN filename: ARRAY OF CHAR): Bitmap;
 VAR bmp: Bitmap;
-BEGIN NEW(bmp); bmp.surface := SDL.ImgLoad(SHORT(filename));
+  s: ARRAY 2048 OF SHORTCHAR;
+BEGIN NEW(bmp); Utf8.Encode(filename, s); bmp.surface := SDL.ImgLoad(s);
   IF bmp.surface = NIL THEN bmp := NIL
   ELSE bmp.w := bmp.surface.w; bmp.h := bmp.surface.h END ;
 RETURN bmp END LoadBitmap;
 
-PROCEDURE SaveBmp*(bmp: Bitmap; filename: ARRAY OF CHAR): BOOLEAN;
-BEGIN
-  RETURN SDL.SaveBmpRW(bmp.surface, SDL.RWFromFile(SHORT(filename), 'wb'), 1) = 0
-END SaveBmp;
+PROCEDURE SaveBmp*(bmp: Bitmap; IN filename: ARRAY OF CHAR): BOOLEAN;
+VAR s: ARRAY 2048 OF SHORTCHAR;
+BEGIN Utf8.Encode(filename, s) ;
+RETURN SDL.SaveBmpRW(bmp.surface, SDL.RWFromFile(s, 'wb'), 1) = 0 END SaveBmp;
 
-PROCEDURE SavePng*(bmp: Bitmap; filename: ARRAY OF CHAR): BOOLEAN;
-VAR s: ARRAY 1024 OF SHORTCHAR;
-BEGIN Utf8.Encode(filename, s);
+PROCEDURE SavePng*(bmp: Bitmap; IN filename: ARRAY OF CHAR): BOOLEAN;
+VAR s: ARRAY 2048 OF SHORTCHAR;
+BEGIN Utf8.Encode(filename, s) ;
 RETURN SDL.ImgSavePng(bmp.surface, s) = 0 END SavePng;
 
-PROCEDURE SaveJpg*(bmp: Bitmap; filename: ARRAY OF CHAR): BOOLEAN;
-VAR s: ARRAY 1024 OF SHORTCHAR;
-BEGIN Utf8.Encode(filename, s);
+PROCEDURE SaveJpg*(bmp: Bitmap; IN filename: ARRAY OF CHAR): BOOLEAN;
+VAR s: ARRAY 2048 OF SHORTCHAR;
+BEGIN Utf8.Encode(filename, s) ;
 RETURN SDL.ImgSaveJpg(bmp.surface, s) = 0 END SaveJpg;
 
 PROCEDURE Blit*(src, dest: Bitmap; sx, sy, sw, sh, dx, dy: INTEGER);
@@ -590,6 +616,49 @@ BEGIN a.x := sx; a.y := sy; a.w := sw; a.h := sh;
   SDL.BlitSurface(src.surface, a, dest.surface, b)
 END Blit;
 
+(*!FIXME remove FlipBlit *)
+PROCEDURE FlipBlit*(src, dest: Bitmap; sx, sy, sw, sh, dx, dy: INTEGER;
+    hFlip: BOOLEAN);
+VAR x, y, sx0: INTEGER;
+  c1, c2, r1, r2, g1, g2, b1, b2, a1, a2: INTEGER;
+BEGIN
+  IF ~hFlip THEN Blit(src, dest, sx, sy, sw, sh, dx, dy)
+  ELSE
+    IF sx < 0 THEN DEC(sw, -sx); INC(dx, -sx); sx := 0
+    ELSIF sx + sw - 1 >= src.w THEN DEC(sw, sx + sw - 1 - src.w)
+    ELSIF dx + sw - 1 >= dest.w THEN DEC(sw, dx + sw - 1 - dest.w)
+    END;
+    IF sy < 0 THEN DEC(sh, -sy); INC(dy, -sy); sy := 0
+    ELSIF sy + sh - 1 >= src.h THEN DEC(sh, sy + sh - 1 - src.h)
+    ELSIF dy + sh - 1 >= dest.h THEN DEC(sh, dy + sh - 1 - dest.h)
+    END;
+    LockBitmap(src);
+    LockBitmap(dest);
+    sx0 := sx + sw - 1;
+    FOR y := dy TO dy + sh - 1 DO
+      sx := sx0;
+      FOR x := dx TO dx + sw - 1 DO
+        c1 := GetPixelFast(src, sx, sy);
+        ColorToRGBA(c1, r1, g1, b1, a1);
+        IF a1 # 0 THEN
+          c2 := GetPixelFast(dest, x, y);
+          ColorToRGBA(c2, r2, g2, b2, a2);
+          IF a1 # 255 THEN
+            c1 := MakeCol((r1 * a1 + r2 * (255 - a1)) DIV 256, 
+                (g1 * a1 + g2 * (255 - g1)) DIV 256, 
+                (b1 * a1 + b2 * (255 - b1)) DIV 256)
+          END;
+          PutPixelFast(dest, x, y, c1)
+        END;
+        DEC(sx)
+      END;
+      INC(sy)
+    END;
+    UnlockBitmap(dest);
+    UnlockBitmap(src)
+  END
+END FlipBlit;
+
 PROCEDURE BlitWhole*(src, dest: Bitmap; x, y: INTEGER);
 VAR b: SDL.Rect;
 BEGIN b.x := x; b.y := y;
@@ -604,11 +673,26 @@ BEGIN
   SDL.BlitScaled(src.surface, a, dest.surface, b)
 END StretchBlit;
 
+PROCEDURE SetScreenAlpha*(alpha: INTEGER);
+BEGIN screenAlpha := alpha
+END SetScreenAlpha;
+
 PROCEDURE SetAlpha*(bmp: Bitmap; alpha: INTEGER);
 BEGIN
   IF SDL.SetSurfaceAlphaMod(bmp.surface, SYSTEM.VAL(BYTE, alpha)) = 0 THEN END
 END SetAlpha;
 
+PROCEDURE SetClip*(bmp: Bitmap; x, y, w, h: INTEGER);
+VAR r: SDL.Rect;
+BEGIN r.x := x; r.y := y; r.w := w; r.h := h;
+  IF SDL.SetClipRect(bmp.surface, r) = 0 THEN END
+END SetClip;
+
+PROCEDURE UnsetClip*(bmp: Bitmap);
+BEGIN
+  IF SDL.SetClipRectNil(bmp.surface) = 0 THEN END
+END UnsetClip;
+
 PROCEDURE MaskedBlit*(src, dest: Bitmap; sx, sy, dx, dy, w, h: INTEGER);
 BEGIN
   (*Al.MaskedBlit(src.bmp, dest.bmp, sx, sy, dx, dy, w, h)*)
@@ -628,12 +712,19 @@ PROCEDURE SetColorKey*(bmp: Bitmap; color: INTEGER);
 BEGIN SDL.SetColorKey(bmp.surface, 1, color)
 END SetColorKey;
 
-(* Font *)
+PROCEDURE SetColorMod*(bmp: Bitmap; r, g, b: INTEGER);
+BEGIN
+  SDL.SetSurfaceColorMod(bmp.surface, r, g, b)
+END SetColorMod;
+
+(* MonoFont *)
 
-PROCEDURE LoadFont*(filename: ARRAY OF CHAR; charW, charH: INTEGER): Font;
-VAR bmp: Bitmap; font: Font;
-    x, y, sx, sy, tmp: INTEGER;
-BEGIN bmp := LoadBitmap(filename);
+PROCEDURE LoadMonoFont*(IN filename: ARRAY OF CHAR;
+    charW, charH: INTEGER): MonoFont;
+VAR bmp: Bitmap; font: MonoFont;
+  x, y, sx, sy, tmp: INTEGER;
+BEGIN
+  bmp := LoadBitmap(filename);
   IF bmp = NIL THEN font := NIL
   ELSE
     bmp.surface := SDL.ConvertSurface(bmp.surface,
@@ -658,7 +749,7 @@ BEGIN bmp := LoadBitmap(filename);
       INC(sy, charH)
     END
   END ;
-RETURN font END LoadFont;
+RETURN font END LoadMonoFont;
 
 PROCEDURE FindFontChar(c: CHAR; OUT n: INTEGER);
 BEGIN
@@ -671,8 +762,8 @@ BEGIN
   END
 END FindFontChar;
 
-PROCEDURE DrawCharacter*(dest: Bitmap; font: Font;
-  x, y: INTEGER; ch: CHAR; fg: INTEGER);
+PROCEDURE DrawCharacter*(dest: Bitmap; font: MonoFont;
+    x, y: INTEGER; ch: CHAR; fg: INTEGER);
 VAR n, fx, fy, r, g, b: INTEGER; dstRect: SDL.Rect;
 BEGIN dstRect.x := x; dstRect.y := y;
   FindFontChar(ch, n);
@@ -687,8 +778,8 @@ BEGIN dstRect.x := x; dstRect.y := y;
   END
 END DrawCharacter;
 
-PROCEDURE DrawString*(dest: Bitmap; font: Font;
-    x, y: INTEGER; s: ARRAY OF CHAR; fg: INTEGER);
+PROCEDURE DrawString*(dest: Bitmap; font: MonoFont;
+    x, y: INTEGER; IN s: ARRAY OF CHAR; fg: INTEGER);
 VAR i, cx: INTEGER;
 BEGIN i := 0; cx := x;
   WHILE (s[i] # 0X) & (cx < dest.w) DO
@@ -697,6 +788,109 @@ BEGIN i := 0; cx := x;
   END
 END DrawString;
 
+(* Font *)
+
+PROCEDURE LoadFont*(IN fname: ARRAY OF CHAR): Font;
+VAR T: Texts.Text;
+  S: Texts.Scanner;
+  i: INTEGER;
+  s: ARRAY 512 OF CHAR;
+  f: Font;
+BEGIN NEW(f);
+  s := fname$; Strings.Append('.png', s);
+  f.bmp := LoadBitmap(s);
+  IF f.bmp = NIL THEN f := NIL
+  ELSE s := fname$; Strings.Append('.dat', s);
+    NEW(T); Texts.Open(T, s);
+    Texts.OpenScanner(S, T, 0);
+    Texts.Scan(S);
+    IF S.class = Texts.Int THEN f.h := S.i ELSE f.h := 0 END;
+    Texts.Scan(S); i := 0;
+    WHILE ~S.eot & (S.class = Texts.Int) DO
+      f.geo[i].w := S.i; Texts.Scan(S);
+      f.geo[i].x := S.i; Texts.Scan(S);
+      f.geo[i].y := S.i; Texts.Scan(S);
+      INC(i)
+    END;
+    f.geoCount := i
+  END;
+RETURN f END LoadFont;
+
+PROCEDURE GetCharGeometry*(font: Font; ch: INTEGER; VAR fx, fy, w: INTEGER);
+VAR i: INTEGER;
+BEGIN
+  IF (32 <= ch) & (ch <= 127) THEN i := ch - 32
+  ELSIF (1040 <= ch) & (ch <= 1103) THEN i := ch - 1040 + 95
+  ELSIF ch = 1025 THEN i := 64 + 95
+  ELSIF ch = 1105 THEN i := 65 + 95;
+  ELSE i := font.geoCount
+  END;
+  IF i >= font.geoCount THEN i := 31 (*'?'*) END;
+  w  := font.geo[i].w;
+  fx := font.geo[i].x;
+  fy := font.geo[i].y
+END GetCharGeometry;
+
+PROCEDURE GetTextWidth*(font: Font; IN s: ARRAY OF CHAR): INTEGER;
+VAR i, w, tw, maxTw, fx, fy: INTEGER;
+  c1, c2: CHAR;
+  ch: INTEGER;
+BEGIN
+  maxTw := 0; tw := 0; i := 0;
+  IF font # NIL THEN
+    WHILE (i < LEN(s) - 1) & (s[i] # 0X) DO
+      c1 := s[i]; c2 := s[i + 1];
+      IF c1 < 80X THEN ch := ORD(c1); INC(i)
+      ELSE ch := ORD(c1) MOD 32 * 64 + ORD(c2) MOD 64; INC(i, 2)
+      END;
+      IF ch = 0AH THEN
+        IF tw > maxTw THEN maxTw := tw END;
+        tw := 0
+      ELSE
+        GetCharGeometry(font, ch, fx, fy, w);
+        INC(tw, w)
+      END
+    END
+  END;
+  IF tw > maxTw THEN maxTw := tw END;
+RETURN maxTw END GetTextWidth;
+
+PROCEDURE DrawChar*(dest: Bitmap; font: Font; x, y, ch, color: INTEGER;
+    VAR w: INTEGER);
+VAR r, g, b, fx, fy: INTEGER; (* Font X, Y *)
+BEGIN
+  IF font # NIL THEN
+    GetCharGeometry(font, ch, fx, fy, w);
+    IF ch # 32 (*space*) THEN
+      ColorToRGB(color, r, g, b);
+      SetColorMod(font.bmp, r, g, b);
+      Blit(font.bmp, dest, fx, fy, w, font.h, x, y)
+    END
+  END
+END DrawChar;
+
+PROCEDURE DrawText*(dest: Bitmap; font: Font; x, y: INTEGER;
+    IN s: ARRAY OF CHAR; color: INTEGER);
+VAR x0, i, w: INTEGER;
+  c1, c2: CHAR;
+  ch: INTEGER;
+BEGIN
+  IF font # NIL THEN
+    x0 := x; i := 0;
+    WHILE (i < LEN(s) - 1) & (s[i] # 0X) DO
+      c1 := s[i]; c2 := s[i + 1];
+      IF c1 < 80X THEN ch := ORD(c1); INC(i)
+      ELSE ch := ORD(c1) MOD 32 * 64 + ORD(c2) MOD 64; INC(i, 2)
+      END;
+      IF ch = 0AH THEN INC(y, font.h); x := x0
+      ELSE DrawChar(dest, font, x, y, ch, color, w); INC(x, w)
+      END
+    END
+  END
+END DrawText;
+
+(* Events *)
+
 PROCEDURE StartTextInput*;
 BEGIN SDL.StartTextInput
 END StartTextInput;
@@ -757,8 +951,7 @@ END UpdateMousePos;
 
 (* Keyboard *)
 
-PROCEDURE GetKeyArray(): KeyArray;
-BEGIN
+PROCEDURE GetKeyArray(): KeyArray; BEGIN
 RETURN SYSTEM.VAL(KeyArray, SDL.GetKeyboardStateNil()) END GetKeyArray;
 
 PROCEDURE KeyDown*(key: INTEGER): BOOLEAN;
@@ -841,8 +1034,7 @@ BEGIN
   needRedrawMouse := TRUE
 END SetMousePointer;
 
-PROCEDURE GetMousePointer*(): Bitmap;
-BEGIN
+PROCEDURE GetMousePointer*(): Bitmap; BEGIN
 RETURN mousePointer END GetMousePointer;
 
 PROCEDURE SetStdMousePointer*;
@@ -854,7 +1046,7 @@ BEGIN CreateStdMousePointer; SetStdMousePointer
 END InitMouseData;
 
 (* Misc *)
-PROCEDURE SetWindowTitle*(title: ARRAY OF CHAR);
+PROCEDURE SetWindowTitle*(IN title: ARRAY OF CHAR);
 VAR s: ARRAY 2048 OF SHORTCHAR;
 BEGIN Utf8.Encode(title, s); SDL.SetWindowTitle(window, s)
 END SetWindowTitle;
@@ -880,20 +1072,13 @@ END SwitchToFullscreen;
 
 PROCEDURE ToggleFullscreen*;
 BEGIN
-  IF fullscreen IN settings THEN SwitchToWindowed
-  ELSE SwitchToFullscreen
-  END
+  IF fullscreen IN settings THEN SwitchToWindowed ELSE SwitchToFullscreen END
 END ToggleFullscreen;
 
 PROCEDURE Delay*(n: INTEGER);
 BEGIN SDL.Delay(n)
 END Delay;
 
-PROCEDURE HandleMouseButton(VAR event: SDL.Event);
-VAR e: SDL.MouseButtonEvent;
-BEGIN
-END HandleMouseButton;
-
 PROCEDURE PumpQuit;
 BEGIN
   IF events.len < LEN(events.buf) THEN
@@ -1030,8 +1215,7 @@ VAR flags: SET;
 BEGIN flags := SDL.GetWindowFlags(window) ;
 RETURN SDL.windowShown IN flags END WindowShown;
 
-PROCEDURE GetTicks*(): INTEGER;
-BEGIN
+PROCEDURE GetTicks*(): INTEGER; BEGIN
 RETURN SDL.GetTicks() END GetTicks;
 
 PROCEDURE Flip*;
@@ -1047,14 +1231,17 @@ VAR mx, my: INTEGER; (* Mouse bitmap X Y *)
     Blit(screen, underMouse, mx, my,
       underMouse.w, underMouse.h, 0, 0);
     (* Blit mouse pointer onto buffer *)
-    Blit(mousePointer, screen, 0, 0,
-      mousePointer.w, mousePointer.h, mx, my)
+    IF mouseX # -1 THEN
+      Blit(mousePointer, screen, 0, 0,
+        mousePointer.w, mousePointer.h, mx, my)
+    END
   END PrepareMouse;
 
   PROCEDURE CleanMouse;
-  BEGIN (* Restore image under mouse in buffer *)
-    Blit(underMouse, screen, 0, 0,
-      underMouse.w, underMouse.h, mx, my);
+  BEGIN
+    IF mouseX # -1 THEN (* Restore image under mouse in buffer *)
+      Blit(underMouse, screen, 0, 0, underMouse.w, underMouse.h, mx, my)
+    END;
     needRedrawMouse := FALSE
   END CleanMouse;
 
@@ -1079,6 +1266,7 @@ BEGIN
       screenTexture := 0
     END;
     screenTexture := SDL.CreateTextureFromSurface(renderer, screen.surface);
+    SDL.SetTextureAlphaMod(screenTexture, screenAlpha);
     SDL.RenderCopyNil(renderer, screenTexture);
     SDL.RenderPresent(renderer);
 
@@ -1086,49 +1274,6 @@ BEGIN
   END
 END Flip;
 
-(* Random *)
-
-PROCEDURE Time(): INTEGER;
-BEGIN
-RETURN SHORT(Platform.Time()) END Time;
-
-(* Set random seed value. Any values are allowed, although
-   values not in [1..2^31-2] will be mapped into this range. *)
-PROCEDURE PutSeed*(newSeed: INTEGER);
-BEGIN newSeed := newSeed MOD randomModulo;
-  IF newSeed = 0 THEN randomSeed := 1
-  ELSE randomSeed := newSeed
-  END
-END PutSeed;
-
-PROCEDURE NextRND;
-CONST a = 16807;
-  q = 127773; (* m div a *)
-  r = 2836;   (* m mod a *)
-VAR lo, hi, test: INTEGER;
-BEGIN
-  hi := randomSeed DIV q;
-  lo := randomSeed MOD q;
-  test := a * lo - r * hi;
-  IF test > 0 THEN randomSeed := test
-  ELSE randomSeed := test + randomModulo
-  END
-END NextRND;
-
-(* Calculates a new number. range has to be included in
-   [1..2^31-2]. Result is a number from 0, 1, ... , range-1. *)
-PROCEDURE Random*(range: INTEGER): INTEGER;
-BEGIN NextRND ;
-RETURN randomSeed MOD range END Random;
-
-(* Calculates a number x with 0.0 <= x < 1.0. *)
-PROCEDURE Uniform*(): REAL;
-BEGIN NextRND ;
-RETURN SHORT((randomSeed - 1) * (1 / (randomModulo - 1))) END Uniform;
-
-PROCEDURE Randomize*;
-BEGIN PutSeed(Time())
-END Randomize;
 
 (* Init *)
 
@@ -1190,7 +1335,7 @@ BEGIN screen := NIL; settings := initSettings;
       END;
       keyPressed := 0;
       lastFlip := -1;
-      Randomize
+      screenAlpha := 255
     END
   END ;
 RETURN screen END Init;
@@ -1217,5 +1362,5 @@ BEGIN
   mouseFocusX := 0; mouseFocusY := 0;
   scaleX := 1; scaleY := 1;
   events.first := 0; events.last := -1; events.len := 0;
-  randomSeed := 1; keyPressed := 0
+  keyPressed := 0
 END Graph.

+ 13 - 1
src/SDL2.Mod

@@ -482,7 +482,13 @@ PROCEDURE -ConvertSurface*(src: Surface; fmt: PixelFormat;
     flags: INTEGER): Surface "(void *)SDL_ConvertSurface(src, fmt, flags)";
 
 PROCEDURE -SetSurfaceColorMod*(surface: Surface; r, g, b: INTEGER)
-    "SDL_SetSurfaceColorMod(surface, r, g, b)";
+    "SDL_SetSurfaceColorMod((void *)surface, r, g, b)";
+
+PROCEDURE -SetTextureColorMod*(texture: Texture; r, g, b: INTEGER)
+    "SDL_SetTextureColorMod((void *)texture, r, g, b)";
+
+PROCEDURE -SetTextureAlphaMod*(texture: Texture; alpha: INTEGER)
+    "SDL_SetTextureAlphaMod((void *)texture, alpha)";
 
 PROCEDURE -GetKeyboardState*(VAR numKeys: INTEGER): KeyArray
     "SDL_GetKeyboardState(numKeys)";
@@ -510,4 +516,10 @@ PROCEDURE -SetWindowFullscreen*(window: Window; flags: SET): INTEGER
 PROCEDURE -SetSurfaceAlphaMod*(surface: Surface; alpha: BYTE): INTEGER
     "SDL_SetSurfaceAlphaMod(surface, alpha)";
 
+PROCEDURE -SetClipRect*(surface: Surface; VAR rect: Rect): INTEGER
+    "SDL_SetClipRect(surface, rect)";
+
+PROCEDURE -SetClipRectNil*(surface: Surface): INTEGER
+    "SDL_SetClipRect(surface, (void *)0)";
+
 END SDL2.

+ 2 - 2
src/Terminal.Mod

@@ -32,7 +32,7 @@ TYPE
 VAR
   screen*: G.Bitmap;
   charsX-, charsY-: INTEGER;
-  font: G.Font;
+  font: G.MonoFont;
 
   chars: ScreenChars;
   cursorX-, cursorY-: INTEGER;
@@ -310,7 +310,7 @@ END WriteString;
 
 PROCEDURE LoadMedia(): BOOLEAN;
 CONST fontFile = 'data/images/font.bmp';
-BEGIN font := G.LoadFont(fontFile, charW, charH);
+BEGIN font := G.LoadMonoFont(fontFile, charW, charH);
   IF font = NIL THEN Out.String('Could not load font file "');
     Out.String(fontFile); Out.String('".'); Out.Ln
   END ;

+ 86 - 0
src/Texts.Mod

@@ -0,0 +1,86 @@
+MODULE Texts;
+IMPORT Files, SYSTEM;
+
+CONST
+  (* Scanner class values *)
+  Inval* = 0; Name* = 1; String* = 2; Int* = 3; Real* = 4;
+  LongReal* = 5; Char* = 6;
+
+TYPE
+  LONGINT* = SYSTEM.INT64;
+
+  Text* = POINTER TO TextDesc;
+  TextDesc* = RECORD
+    len*: LONGINT;
+    F: Files.File
+  END;
+
+  Reader* = RECORD
+    eot*: BOOLEAN;
+    rider: Files.Rider
+  END;
+
+  Scanner* = RECORD(Reader)
+    nextCh*: CHAR;
+    line*, class*: INTEGER;
+    i*: INTEGER;
+    x*: REAL;
+    (*y*: LONGREAL;*)
+    c*: CHAR;
+    len*: LONGINT;
+    s*: ARRAY 512 OF CHAR
+  END;
+
+PROCEDURE Open*(T: Text; fname: ARRAY OF CHAR);
+BEGIN T.F := Files.Old(fname);
+  IF T.F # NIL THEN
+    T.len := Files.Length(T.F)
+  ELSE T.len := 0
+  END
+END Open;
+
+PROCEDURE Next*(VAR S: Scanner);
+BEGIN
+  Files.ReadChar(S.rider, S.nextCh)
+END Next;
+
+PROCEDURE OpenScanner*(VAR S: Scanner; T: Text; pos: LONGINT);
+BEGIN
+  Files.Set(S.rider, T.F, pos);
+  Next(S)
+END OpenScanner;
+
+PROCEDURE Scan*(VAR S: Scanner);
+VAR n: INTEGER;
+BEGIN
+  WHILE ~S.rider.eof & (S.nextCh <= ' ') DO Next(S) END;
+  IF ('0' <= S.nextCh) & (S.nextCh <= '9') THEN
+    n := 0;
+    REPEAT
+      n := n * 10 + ORD(S.nextCh) - ORD('0');
+      Next(S)
+    UNTIL S.rider.eof OR ~(('0' <= S.nextCh) & (S.nextCh <= '9'));
+    S.class := Int;
+    S.i := n
+  ELSE
+    S.class := Char;
+    S.c := S.nextCh;
+    Next(S)
+  END;
+  S.eot := S.rider.eof
+END Scan;
+
+END Texts.
+
+(*
+VAR T: Texts.Text;
+  S: Texts.Scanner;
+BEGIN
+  NEW(T);
+  Texts.Open(T, s);
+  Texts.OpenScanner(S, T, 0);
+  S.eot: BOOLEAN
+  Texts.Scan(S);
+  S.class = Texts.Int
+  S.i: INTEGER
+*)

+ 8 - 2
src/make.sh

@@ -28,6 +28,10 @@ $OFR -C Out.Mod
 
 $OFR -C Files.Mod
 
+$OFR -7w Texts.Mod
+
+$OFR -7w Random.Mod
+
 $OFR -7w StrList.Mod
 
 $OFR -7w Dir.Mod
@@ -57,16 +61,18 @@ $CCFULL -c Int.c
 $CCFULL -c In.c
 $CCFULL -c Out.c
 $CCFULL -c Files.c
+$CCFULL -c Texts.c
+$CCFULL -c Random.c
 $CCFULL -c StrList.c
 $CCFULL -c Dir.c
 $CCFULL -c SDL2.c
 $CCFULL -c Graph.c
 $AR -crs ../data/bin/libFreeOberon.a \
-  Utf8.o Strings.o Reals.o Int.o In.o Out.o Files.o \
+  Utf8.o Strings.o Reals.o Int.o In.o Out.o Files.o Texts.o Random.o \
   StrList.o Dir.o SDL2.o Graph.o
 
 $CCFULL Config.c term/term_linux.c \
-  Utf8.o Strings.o Reals.o Int.o In.o Out.o Files.o \
+  Utf8.o Strings.o Reals.o Int.o In.o Out.o Files.o Texts.o Random.o \
   StrList.o Dir.o SDL2.o Graph.o \
   Term.c Terminal.c OV.c EditorText.c Editor.c \
   $PROG.c -o ../$PROG \