浏览代码

Amiga: Implemented GetVar for 1.x

Marcus Sackrow 4 年之前
父节点
当前提交
e1a75bf658
共有 2 个文件被更改,包括 45 次插入3 次删除
  1. 39 0
      packages/amunits/src/coreunits/amigados.pas
  2. 6 3
      packages/rtl-console/src/amicommon/video.pp

+ 39 - 0
packages/amunits/src/coreunits/amigados.pas

@@ -1781,6 +1781,10 @@ FUNCTION WriteChars(const buf : pCHAR location 'd1'; buflen : ULONG location 'd2
 FUNCTION BADDR(bval :BPTR): POINTER;
 FUNCTION MKBADDR(adr: Pointer): BPTR;
 
+{$if defined(AMIGA_V1_2_ONLY)}
+function GetVar(const Name: PChar; Buffer: PChar; Size: LongInt; Flags: LongInt): LongInt;
+{$endif}
+
 {$if not defined(AMIGA_V1_2_ONLY)}
 // var args version
 FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER;
@@ -1872,6 +1876,41 @@ FUNCTION MKBADDR(adr : POINTER): BPTR; inline;
 BEGIN
     MKBADDR := BPTR( PTRUINT(adr) shr 2);
 END;
+
+{$if defined(AMIGA_V1_2_ONLY)}
+function GetVar(const Name: PChar; Buffer: PChar; Size: LongInt; Flags: LongInt): LongInt;
+var
+  Anchor: TAnchorPath;
+  FName: AnsiString;
+  FLock: BPTR;
+  Fh: BPTR;
+  MyProc: PProcess;
+  OldWinPtr: Pointer;
+begin
+  GetVar := -1;
+  //
+  MyProc := PProcess(FindTask(Nil));
+  OldWinPtr := MyProc^.pr_WindowPtr;
+  MyProc^.pr_WindowPtr := Pointer(-1);
+  //
+  FName := 'ENV:' + AnsiString(Name);
+  FLock := Lock(PChar(FName), SHARED_LOCK);
+  if FLock <> 0 then
+  begin
+    UnLock(FLock);
+    // search in env for all Variables
+    Fh := DosOpen(PChar(FName), MODE_OLDFILE);
+    if Fh <> 0 then
+    begin
+      GetVar := DosRead(Fh, Buffer, Size);
+      DosClose(FH);
+    end;
+  end;
+  //
+  MyProc^.pr_WindowPtr := OldWinPtr;
+end;
+{$endif}
+
 {$if not defined(AMIGA_V1_2_ONLY)}
 FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER;
 begin

+ 6 - 3
packages/rtl-console/src/amicommon/video.pp

@@ -177,10 +177,8 @@ var
   videoDefaultFlags: PtrUInt;
 begin
   videoDefaultFlags:=VIDEO_WFLG_DEFAULTS;
-  {$if not defined(AMIGA_V1_2_ONLY)}
   if GetVar('FPC_VIDEO_SIMPLEREFRESH',@envBuf,sizeof(envBuf),0) > -1 then
     videoDefaultFlags:=videoDefaultFlags and not WFLG_SMART_REFRESH;
-  {$endif}
   if FPC_VIDEO_FULLSCREEN then
   begin
     OS_Screen := GetScreen;
@@ -277,6 +275,7 @@ begin
   {$else}
   VideoFont:=@vgafont;
   VideoFontHeight:=16;
+  {$endif}
   if GetVar('FPC_VIDEO_BUILTINFONT',@envBuf,sizeof(envBuf),0) > -1 then
     begin
       case lowerCase(envBuf) of
@@ -290,9 +289,13 @@ begin
             VideoFont:=@vgafont14;
             VideoFontHeight:=14;
           end;
+        'vga16':
+          begin
+            VideoFont:=@vgafont;
+            VideoFontHeight:=16;
+          end;
       end;
     end;
-  {$endif}
 
   // fill videobuf and oldvideobuf with different bytes, to allow proper first draw
   FillDword(VideoBuf^, VideoBufSize div 4, $1234D3AD);