2
0
Эх сурвалжийг харах

rtl/atari: fix readln from console

Thorsten Otto 3 жил өмнө
parent
commit
46ab8d79a2

+ 5 - 5
rtl/atari/sysfile.inc

@@ -245,10 +245,10 @@ end;
 
 
 function do_isdevice(handle: thandle): boolean;
+var pos, newpos: longint;
 begin
-  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
-     (handle=StdErrorHandle) then
-    do_isdevice:=True
-  else
-    do_isdevice:=False;
+  pos := gemdos_fseek(0, handle, SEEK_FROM_CURRENT);
+  newpos := gemdos_fseek(1, handle, SEEK_FROM_START);
+  gemdos_fseek(pos, handle, SEEK_FROM_START);
+  do_isdevice := (newpos=0) or (pos=ESPIPE);
 end;

+ 42 - 5
rtl/atari/system.pp

@@ -145,14 +145,51 @@ end;
                          SystemUnit Initialization
 *****************************************************************************}
 
+Procedure ConsoleRead(var t:TextRec);
+var
+  dosResult: longint;
+Begin
+  dosResult:=gemdos_fread(t.Handle,t.BufSize,t.Bufptr);
+  t.BufPos:=0;
+  { Reading from console on TOS does not include the terminating CR/LF }
+  if (dosResult >= 0) then
+    begin
+      t.BufEnd := dosResult;
+      if (dosResult>=1) and (t.Bufptr^[dosResult-1] = #10) then
+        begin end
+      else
+      if (t.BufEnd < t.BufSize) then
+        begin
+          t.BufPtr^[t.BufEnd] := #13;
+          inc(t.BufEnd);
+        end;
+      if (t.BufEnd < t.BufSize) then
+        begin
+          t.BufPtr^[t.BufEnd] := #10;
+          inc(t.BufEnd);
+        end;
+    end
+  else
+    Error2InOutRes(dosResult);
+End;
+
+procedure myOpenStdIO(var f:text;mode:longint;hdl:thandle);
+begin
+  OpenStdIO(f, mode, hdl);
+  if (InOutRes=0) and (Mode=fmInput) and Do_Isdevice(hdl) then
+  begin
+    TextRec(f).InOutFunc:=@ConsoleRead;
+  end;
+end;
+
 procedure SysInitStdIO;
 begin
-  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+  myOpenStdIO(Input,fmInput,StdInputHandle);
+  myOpenStdIO(Output,fmOutput,StdOutputHandle);
+  myOpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
 {$ifndef FPC_STDOUT_TRUE_ALIAS}
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  myOpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  myOpenStdIO(StdErr,fmOutput,StdErrorHandle);
 {$endif FPC_STDOUT_TRUE_ALIAS}
 end;