paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 20:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amiga: Implemented GetVar for 1.x

Browse Source
This commit is contained in:
Marcus Sackrow 2021-08-08 14:49:27 +01:00
parent 6a3f32ba69
commit e1a75bf658
2 changed files with 45 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
packages/amunits/src/coreunits/amigados.pas
View File

@ -1781,6 +1781,10 @@ FUNCTION WriteChars(const buf : pCHAR location 'd1'; buflen : ULONG location 'd2
FUNCTION BADDR(bval :BPTR): POINTER; FUNCTION BADDR(bval :BPTR): POINTER;
FUNCTION MKBADDR(adr: Pointer): BPTR; 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)} {$if not defined(AMIGA_V1_2_ONLY)}
// var args version // var args version
FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER; FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER;
@ -1872,6 +1876,41 @@ FUNCTION MKBADDR(adr : POINTER): BPTR; inline;
BEGIN BEGIN
MKBADDR := BPTR( PTRUINT(adr) shr 2); MKBADDR := BPTR( PTRUINT(adr) shr 2);
END; 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)} {$if not defined(AMIGA_V1_2_ONLY)}
FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER; FUNCTION AllocDosObjectTags(type_ : ULONG; Const argv : Array of PtrUInt) : POINTER;
begin begin

9
packages/rtl-console/src/amicommon/video.pp
View File

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