Windows Link Graph script fixed, term fixed - env variables for running program; BlitBmp examples updated and renamed to Rocket

Data/bin/link_console.sh

@@ -28,7 +28,7 @@ shift
 
 
 
-$CC -g3 -O0 -fno-exceptions \
+$CC -O0 -fno-exceptions \
   -I $FOBDIR/src \
   -I $OFRDIR/Mod/Lib \
   -I $OFRTAR/Lib/Obj \

Data/bin/link_graph.bat

@@ -1,19 +1,21 @@
 @ECHO OFF
-REM This script is run by Free Oberon on Windows. Current directory of the
-REM script will be where FreeOberon.exe is located. This particular script
-REM is for graphical programs.
+REM This script is run by Free Oberon on Windows
+REM to link a graphics program.
+REM When it is being run, the current directory
+REM must be the root directory of Free Oberon.
 
 CD bin >nul 2>&1
 @DEL /s %~n1.exe >nul 2>&1
 SET CURDIR=%~dp0
 SET ONAME=%~n1
-SET OFRDIR=%CURDIR%OfrontPlus\Target\Win32
-SET PATH=%OFRDIR%;%CURDIR%mingw32\bin;%PATH%
+SET GCCDIR=%CURDIR%mingw32\bin
+SET FOBDIR=%CURDIR%..\..
+SET OFRDIR=%CURDIR%OfrontPlus
+SET OFRTAR=%OFRDIR%\Target\Win32
+SET PATH=%OFRTAR%;%GCCDIR%;%PATH%
 SET CC=gcc
-REM SET SDL2Opts=-w -Wl,-subsystem,windows -lmingw32 -lSDL2main -lSDL2
-SET SDL2Opts=-lmingw32 -lSDL2main -lSDL2
 
-REM Put all arguments starting from 2nd to ARGS.
+REM Put all arguments starting from the 2nd to ARGS
 SHIFT
 SET ARGS=%1
 SHIFT
@@ -26,18 +28,19 @@ GOTO START
 REM END Put all ARGS.
 ECHO ON
 
-%CC% -O0 -fno-exceptions ^
-  -I %CURDIR%..\..\src ^
-  -I %OFRDIR%\..\..\Mod\Lib ^
-  -I %OFRDIR%\Lib\Obj ^
+@%CC% -O0 -fno-exceptions ^
+  -I %FOBDIR%\src ^
+  -I %OFRDIR%\Mod\Lib ^
+  -I %OFRTAR%\Lib\Obj ^
   %ONAME%.c -o %ONAME%.exe ^
-  %ARGS%^
-  %CURDIR%FreeOberon.a ^
-  %OFRDIR%\Lib\Ofront.a ^
-  %SDL2Opts% -lSDL2_image ^
-  -Wl,-subsystem,windows ^
-  -Wl,-e_WinMain@16 ^
-  -nostartfiles %OFRDIR%\..\..\Mod\Lib\crt1.c
+  %ARGS% ^
+  %FOBDIR%\Data\bin\FreeOberon.a ^
+  %OFRTAR%\Lib\Ofront.a ^
+  -lallegro -lallegro_primitives -lallegro_image ^
+  -I..\Data\bin\mingw32\include ^
+  -Wl,-e_WinMain@16 -nostartfiles ^
+  %OFRDIR%\Mod\Lib\crt1.c ^
+  -Wl,-subsystem,windows
 
 @SET RETCODE=%ERRORLEVEL%
 

Data/bin/link_graph.sh

@@ -1,9 +1,8 @@
 #!/bin/bash
-#   This script is run by Free Oberon on Linux.
+#   This script is run by Free Oberon on Linux
+#   to link a graphics program.
 #   When it is being run, the current directory
 #   must be the root directory of Free Oberon.
-#   script will be in the bin directory. It
-#   links a graphical program with Allegro 5.
 
 THENAME="${1%.*}"
 ONAME="${THENAME##*/}"
@@ -15,6 +14,8 @@ cd bin
 
 
 
+
+
 shift
 
 
@@ -27,7 +28,7 @@ shift
 
 
 
-$CC -g3 -O0 -fno-exceptions \
+$CC -O0 -fno-exceptions \
   -I ../src \
   -I $OFRDIR/../../Mod/Lib \
   -I $OFRDIR/Lib/Obj \

Programs/BlitBmp.Mod

@@ -1,11 +0,0 @@
-MODULE BlitBmp;
-IMPORT G := Graph;
-VAR s, b: G.Bitmap;
-BEGIN
-  s := G.Init();
-  IF s = NIL THEN HALT(3) END;
-  b := G.LoadBitmap('../Data/Examples/rocket.png');
-  IF b = NIL THEN HALT(4) END;
-  G.BlitWhole(b, s, 100, 60);
-  G.Flip; G.Pause; G.Close
-END BlitBmp.

Programs/BlitBmp2.Mod

@@ -1,36 +0,0 @@
-MODULE BlitBmp2;
-IMPORT G := Graph2, S := SYSTEM;
-CONST N = 100;
-VAR s, b: G.Bitmap;
-  x, y, vx, vy: ARRAY N OF REAL;
-  i: INTEGER;
-BEGIN
-  s := G.Init();
-  IF s = NIL THEN HALT(3) END;
-  b := G.LoadBitmap('../Data/Examples/rocket.png');
-  IF b = NIL THEN HALT(4) END;
-  FOR i := 0 TO N - 1 DO
-    x[i] := s.w * G.Uniform();
-    y[i] := s.h * G.Uniform();
-    vx[i] := 0.0; vy[i] := -G.Uniform() * 5 - 0.3
-  END;
-  REPEAT
-    G.ClearScreen;
-    G.StretchBlit(b, s, 0, 0, b.w, b.h, 0, 0, s.w, s.h);
-    FOR i := 0 TO N - 1 DO
-      G.BlitWhole(b, s, FLOOR(x[i]), FLOOR(y[i]));
-      x[i] := x[i] + vx[i]; y[i] := y[i] + vy[i];
-      IF x[i] < -b.w THEN x[i] := x[i] + s.w + b.w
-      ELSIF x[i] > s.w THEN x[i] := x[i] - s.w - b.w
-      END;
-      IF y[i] < -b.h THEN y[i] := y[i] + s.h + b.h
-      ELSIF y[i] > s.h THEN y[i] := y[i] - s.h - b.h
-      END;
-      vx[i] := vx[i] + (G.Uniform() * 2 - 1) / 50;
-      vy[i] := vy[i] + (G.Uniform() * 2 - 1) / 50
-    END;
-    G.Flip;
-    G.Delay(20)
-  UNTIL G.KeyPressed();
-  G.Close
-END BlitBmp2.

Programs/Rocket1.Mod

@@ -0,0 +1,12 @@
+MODULE Rocket1;
+IMPORT G := Graph, Out;
+VAR b: G.Bitmap;
+BEGIN
+  G.Init();
+  b := G.LoadBitmap('../Data/Examples/rocket.png');
+  IF b = NIL THEN Out.String('Coult not load rocket.png'); Out.Ln
+  ELSE
+    G.Draw(b, 100, 60);
+    G.Flip; G.Pause; G.Close
+  END
+END Rocket1.

Programs/Rocket2.Mod

@@ -0,0 +1,58 @@
+MODULE Rocket2;
+IMPORT Out, Random, G := Graph, M := Math;
+CONST N = 100;
+VAR b: G.Bitmap;
+  x, y, vx, vy: ARRAY N OF REAL;
+  w, h, pw, ph, i: INTEGER;
+  t: REAL;
+  c: G.Color;
+BEGIN
+  (* Try theese settings:    (the default is (640, 400, {})) *)
+  (* G.Settings(0, 0, {}); *)
+  (* G.Settings(0, 0, {G.window}); *)
+  (* G.Settings(320, 200, {}); *)
+  (* G.Settings(320, 200, {G.smooth}); *)
+  (* G.Settings(320, 200, {G.exact}); *)
+  (* G.Settings(320, 200, {G.smooth, G.exact}); *)
+  (* G.Settings(800, 600, {G.exact}); *)
+  (* G.Settings(420, 900, {G.smooth, G.exact}); *)
+  G.Init();
+  G.ShowMouse(FALSE);
+  G.GetTargetSize(w, h);
+  b := G.LoadBitmap('../Data/Examples/rocket.png');
+  IF b = NIL THEN
+    Out.String('Could not load rocket.png'); Out.Ln; ASSERT(FALSE)
+  END;
+  FOR i := 0 TO N - 1 DO
+    x[i] := w * Random.Uniform();
+    y[i] := h * Random.Uniform();
+    vx[i] := 0.0; vy[i] := -Random.Uniform() * 5 - 0.3
+  END;
+  t := 0.0;
+  REPEAT
+    G.MakeCol(c, 10, 30, 60 + FLOOR(60 * M.cos(t / 40)));
+    G.ClearToColor(c);
+    pw := FLOOR(h * b.w / b.h * (0.65 + 0.05 * M.sin(t)));
+    ph := FLOOR(h * (0.65 + 0.05 * M.cos(t)));
+    G.DrawEx(b, 0, 0, b.w, b.h,
+      (w - pw) DIV 2,
+      (h - ph) DIV 2 - FLOOR(h * 0.2 * M.sin(t / 40)),
+      pw, ph, {});
+    FOR i := 0 TO N - 1 DO
+      G.Draw(b, FLOOR(x[i]), FLOOR(y[i]));
+      x[i] := x[i] + vx[i]; y[i] := y[i] + vy[i];
+      IF x[i] < -b.w THEN x[i] := x[i] + w + b.w
+      ELSIF x[i] > w THEN x[i] := x[i] - w - b.w
+      END;
+      IF y[i] < -b.h THEN y[i] := y[i] + h + b.h
+      ELSIF y[i] > h THEN y[i] := y[i] - h - b.h
+      END;
+      vx[i] := vx[i] + (Random.Uniform() * 2 - 1) / 50;
+      vy[i] := vy[i] + (Random.Uniform() * 2 - 1) / 50
+    END;
+    G.Flip;
+    G.Delay(20);
+    t := t + 0.15
+  UNTIL G.KeyPressed();
+  G.Close
+END Rocket2.

Programs/TestGraph.Mod

@@ -91,4 +91,4 @@ END Do;
 
 BEGIN
   Do
-END TestGraph.
+END TestGraph.

src/FreeOberon.Mod

@@ -868,6 +868,7 @@ BEGIN w := c.app.windows;
         needWindowed := graph;
         IF CompileAll(modules, graph, exename) THEN
           tempWindowed := needWindowed & T.IsFS();
+          tempWindowed := FALSE; (*!FIXME Test on Linux and then remove tempWindowed alltogeter*)
           IF tempWindowed THEN T.SwitchToWindow END;
           RunProgram(exename)
         END

src/Graph.Mod

@@ -1169,11 +1169,9 @@ BEGIN
 RETURN c END ReadKey;
 
 PROCEDURE Pause*;
-BEGIN
-
+BEGIN IF ReadKey() = 0X THEN END
 END Pause;
 
-
 PROCEDURE DropNextEvent*;
 VAR e: Event;
 BEGIN (*WaitEvent(e)*)

src/term/term_win32.c

@@ -149,8 +149,45 @@ int StartProcessIn(char *process, char *dir) {
   siStartInfo.dwFlags |= STARTF_USESTDHANDLES;
   siStartInfo.wShowWindow = SW_HIDE;
 
-  /* Environment block */
-  char chNewEnv[100] = "PATH=..\0"; // Must end with 2 \0s
+  /* Environment variables */
+  
+  LPTSTR pszOldVal, childEnvPath;
+  BOOL envPathExists = TRUE;
+  DWORD pathSize, dwRet, dwErr;
+  
+  // Save original value of the PATH environment variable
+  pszOldVal = (LPTSTR)malloc(BUFSIZE * sizeof(TCHAR));
+  pathSize = GetEnvironmentVariable(TEXT("PATH"), pszOldVal, BUFSIZE);
+  if (pathSize == 0) {
+    dwErr = GetLastError();
+    if (dwErr == ERROR_ENVVAR_NOT_FOUND) {
+      envPathExists = FALSE;
+    }
+  } else if (BUFSIZE < pathSize) {
+    pszOldVal = (LPTSTR)realloc(pszOldVal, pathSize * sizeof(TCHAR));
+    if (pszOldVal == NULL) {
+      ErrorExit(TEXT("realloc out memory"));
+    }
+    dwRet = GetEnvironmentVariable(TEXT("PATH"), pszOldVal, pathSize);
+    if (!dwRet) {
+      ErrorExit(TEXT("GetEnvironmentVariable failed"));
+    }
+  }
+  
+  // Determine the value of environment variable PATH for the child process
+  childEnvPath = (LPTSTR)malloc((pathSize + 3) * sizeof(TCHAR));
+  if (childEnvPath == NULL) {
+    ErrorExit(TEXT("malloc out memory"));
+  }
+  childEnvPath[0] = '.';
+  childEnvPath[1] = '.';
+  childEnvPath[2] = ';';
+  memcpy(childEnvPath + 3, pszOldVal, pathSize);
+  
+  // Set value of PATH for child process to inherit
+  if (!SetEnvironmentVariable(TEXT("PATH"), childEnvPath)) {
+    ErrorExit(TEXT("SetEnvironmentVariable 1 failed"));
+  }
 
   // Create the child process.
   bSuccess = CreateProcess(NULL,
@@ -159,13 +196,22 @@ int StartProcessIn(char *process, char *dir) {
     NULL,    // primary thread security attributes
     TRUE,    // handles are inherited
     CREATE_NO_WINDOW, // creation flags
-    (LPVOID)chNewEnv, // environment block
+    NULL,         // environment block
     dir,          // current directory of the process
     &siStartInfo, // STARTUPINFO pointer
     &piProcInfo); // receives PROCESS_INFORMATION
   
   // If an error occurs, exit the application.
   if (!bSuccess) ErrorExit(TEXT("CreateProcess"));
+  
+  // Restore original value of PATH
+  if (envPathExists) {
+    if (!SetEnvironmentVariable(TEXT("PATH"), pszOldVal)) {
+      ErrorExit(TEXT("SetEnvironmentVariable 2 failed"));
+    }
+  } else {
+    SetEnvironmentVariable(TEXT("PATH"), NULL);
+  }
 
   return bSuccess ? 1 : 0;
 }