瀏覽代碼

rtl/atari: fix readln from console

Thorsten Otto 3 年之前
父節點
當前提交
46ab8d79a2
共有 2 個文件被更改,包括 47 次插入10 次删除
  1. 5 5
      rtl/atari/sysfile.inc
  2. 42 5
      rtl/atari/system.pp

+ 5 - 5
rtl/atari/sysfile.inc

@@ -245,10 +245,10 @@ end;
 
 
 
 
 function do_isdevice(handle: thandle): boolean;
 function do_isdevice(handle: thandle): boolean;
+var pos, newpos: longint;
 begin
 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;
 end;

+ 42 - 5
rtl/atari/system.pp

@@ -145,14 +145,51 @@ end;
                          SystemUnit Initialization
                          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;
 procedure SysInitStdIO;
 begin
 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}
 {$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}
 {$endif FPC_STDOUT_TRUE_ALIAS}
 end;
 end;