Recent

Author Topic: [SOLVED] Console Output  (Read 3846 times)

JoeJoeTV

  • New Member
  • *
  • Posts: 40
Re: Console Output
« Reply #30 on: January 01, 2019, 01:34:38 pm »
This code work OK for me in Ubuntu:

Code: Pascal  [Select]
  1. uses sysutils, Keyboard;
  2. var
  3.   K: TKeyEvent;
  4. begin
  5.   InitKeyBoard;
  6.   repeat
  7.     K:=PollKeyEvent;
  8.     If k<>0 then begin
  9.       K:=GetKeyEvent;
  10.       K:=TranslateKeyEvent(K);
  11.       writeln;
  12.       Writeln('Pressed: ', KeyEventToString(K));
  13.     end else begin
  14.       write('.');
  15.     end;
  16.     sleep(100);
  17.   until KeyEventToString(K) = 'q';
  18.   DoneKeyboard;
  19. end.
  20.  

Read chars from STDIN and send to the STDOUT, without block the program.

I have tried that before, but then i can't  get it to show up normally.

Here is my test program:
Code: Pascal  [Select]
  1. program basicConsoleTest;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
  7.   cthreads,
  8.   {$ENDIF}{$ENDIF}
  9.   Classes,
  10.   { you can add units after this }
  11.   sysutils, crt, Keyboard, Mouse
  12.   ;
  13.  
  14. var
  15.   running: Boolean;
  16.   cmd: String;
  17.  
  18.   currentInputString: String;
  19.  
  20. // Blocking Input Reading
  21.  
  22. procedure handleCommand(cmd: String);
  23. begin
  24.   if cmd = 'help' then
  25.     begin
  26.       WriteLn('Help:');
  27.       WriteLn('help - writes this text');
  28.       WriteLn('...');
  29.     end
  30.   else if cmd = 'test' then
  31.     begin
  32.       WriteLn('This is a test command');
  33.     end
  34.   else if cmd = 'exit' then
  35.     begin
  36.       WriteLn('Exiting...');
  37.       Sleep(800);
  38.       running := False;
  39.     end
  40.   else
  41.     begin
  42.       WriteLn('Unknown Command!');
  43.       WriteLn('Enter "help" to get a not finished list of commands.');
  44.     end;
  45. end;
  46.  
  47. function getCommand(): String;
  48. begin
  49.   Write('> ');
  50.   ReadLn(Result);
  51. end;
  52.  
  53. // Non-Blocking Input Reading with Keyboard Unit
  54.  
  55. procedure updateInputText();
  56. begin
  57.   //GotoXY(WindMinX,WindMaxY);
  58.   //DelLine;
  59.   ClrEol;
  60.   //GotoXY(WindMinX,WindMaxY);
  61.   Write(currentInputString);
  62. end;
  63.  
  64. procedure checkKeyboardInput();
  65. var
  66.   keyEvent: TKeyEvent;
  67. begin
  68.   keyEvent := PollKeyEvent;
  69.  
  70.   if keyEvent <> 0 then
  71.     begin
  72.       //Write('Key Pressed ');
  73.       keyEvent := GetKeyEvent;
  74.       keyEvent := TranslateKeyEvent(keyEvent);
  75.  
  76.       case GetKeyEventFlags(keyEvent) of
  77.         kbASCII: begin
  78.           //Write('ASCII (ORD:'+inttostr(Ord(GetKeyEventChar(keyEvent)))+') ');
  79.           if (Ord(GetKeyEventChar(keyEvent)) > 0) and (Ord(GetKeyEventChar(keyEvent)) < 32) then
  80.             begin
  81.               case Ord(GetKeyEventChar(keyEvent)) of
  82.                 8: begin
  83.                     //Write(' BACKSPACE ');
  84.                     if Length(currentInputString) > 0 then
  85.                       Delete(currentInputString,Length(currentInputString),1);
  86.  
  87.                     updateInputText();
  88.                   end;
  89.                 13: begin
  90.                     //Write('ENTER ');
  91.                     currentInputString := '';
  92.                     updateInputText();
  93.                   end;
  94.                 end;
  95.             end
  96.           else
  97.             begin
  98.               //Write(' Normal Character ');
  99.               currentInputString := currentInputString + GetKeyEventChar(keyEvent);
  100.               updateInputText();
  101.             end;
  102.           end;
  103.         {kbUniCode: doNothing();
  104.         kbFnKey: doNothing();
  105.         kbPhys: doNothing();
  106.         kbReleased: doNothing();  }
  107.       end;
  108.       WriteLn('');
  109.     end;
  110. end;
  111.  
  112. //Forums
  113. {
  114. procedure keyboardTestNonBlocking();
  115. var
  116.   K: TKeyEvent;
  117. begin
  118.   repeat
  119.     K:=PollKeyEvent;
  120.     If k<>0 then begin
  121.       K:=GetKeyEvent;
  122.       K:=TranslateKeyEvent(K);
  123.       writeln;
  124.       Writeln('Pressed: ', KeyEventToString(K));
  125.     end else begin
  126.       write('.');
  127.     end;
  128.     sleep(100);
  129.   until KeyEventToString(K) = 'q';
  130. end;
  131. }
  132. // Main Procedures
  133.  
  134. procedure firstRun();
  135. begin
  136.   InitKeyboard;
  137.   InitMouse;
  138.  
  139.   WriteLn('This is a very simple test program!');
  140.   WriteLn('Enter a command:');
  141. end;
  142.  
  143. procedure mainLoop();
  144. begin
  145.   //cmd := getCommand();
  146.   //handleCommand(cmd);
  147.  
  148.   //keyboardTestNonBlocking();
  149.  
  150.   checkKeyboardInput();
  151.  
  152. end;
  153.  
  154. procedure onExit();
  155. begin
  156.   DoneKeyboard;
  157.   DoneMouse;
  158. end;
  159.  
  160.  
  161. begin
  162.   running := True;
  163.   GotoXY(WindMinX,WindMaxY);
  164.   firstRun();
  165.  
  166.   while running do
  167.     begin
  168.       mainLoop();
  169.     end;
  170.  
  171.   onExit();
  172. end.
  173.  
Lazarus 2.0.4 / FPC 3.0.4 / 32+64bit / Windows 10

Edson

  • Hero Member
  • *****
  • Posts: 1044
Re: Console Output
« Reply #31 on: January 01, 2019, 05:30:25 pm »
When you do command processors (or shell), it's better you separate the text received (input Buffer), from the text shown (Echo, Line refresh, ...)  >:D.

* The text buffer acumulate the chars the user send, considering the user can edit it. It edition you need to edit the internal string.
* The text shown, is the text the user see in screen (terminal). It can be edited too, if the terminal have edition option. A common terminal like VT100, have commands to refresh line, clear line, clear screen, delete char, scroll, ...

This architecture is similar to the Model-View pattern.  :D

Code: Pascal  [Select]
  1. program basicConsoleTest;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
  7.   cthreads,
  8.   {$ENDIF}{$ENDIF}
  9.   Classes,
  10.   { you can add units after this }
  11.   sysutils, crt, Keyboard, Mouse
  12.   ;
  13.  
  14. var
  15.   running: Boolean;
  16.   cmd: String;
  17.  
  18.   currentInputString: String;
  19.  
  20. // Blocking Input Reading
  21.  
  22. procedure handleCommand(cmd: String);
  23. begin
  24.   if cmd = 'help' then
  25.     begin
  26.       WriteLn('Help:');
  27.       WriteLn('help - writes this text');
  28.       WriteLn('...');
  29.     end
  30.   else if cmd = 'test' then
  31.     begin
  32.       WriteLn('This is a test command');
  33.     end
  34.   else if cmd = 'exit' then
  35.     begin
  36.       WriteLn('Exiting...');
  37.       Sleep(800);
  38.       running := False;
  39.     end
  40.   else
  41.     begin
  42.       WriteLn('Unknown Command!');
  43.       WriteLn('Enter "help" to get a not finished list of commands.');
  44.     end;
  45. end;
  46.  
  47. function getCommand(): String;
  48. begin
  49.   Write('> ');
  50.   ReadLn(Result);
  51. end;
  52.  
  53. // Non-Blocking Input Reading with Keyboard Unit
  54.  
  55. procedure checkKeyboardInput();
  56. var
  57.   keyEvent: TKeyEvent;
  58.   keyChar: Char;
  59. begin
  60.   keyEvent := PollKeyEvent;
  61.  
  62.   if keyEvent <> 0 then
  63.     begin
  64.       //Write('Key Pressed ');
  65.       keyEvent := GetKeyEvent;
  66.       keyEvent := TranslateKeyEvent(keyEvent);
  67.       keyChar := GetKeyEventChar(keyEvent);
  68.       case GetKeyEventFlags(keyEvent) of
  69.         kbASCII: begin
  70.           //Write('ASCII (ORD:'+inttostr(Ord(keyChar))+') ');
  71.           if (Ord(keyChar) > 0) and (Ord(keyChar) < 32) then
  72.             begin
  73.               case Ord(keyChar) of
  74.                 8: begin
  75.                     //Write(' BACKSPACE ');
  76.                     if Length(currentInputString) > 0 then
  77.                       Delete(currentInputString,Length(currentInputString),1);
  78.  
  79.                   end;
  80.                 13: begin
  81.                     //Write('ENTER ');
  82.                     WriteLn('');
  83.                     writeln('You typed: ', currentInputString);
  84.                     currentInputString := '';
  85.                   end;
  86.                 end;
  87.             end
  88.           else
  89.             begin
  90.               //Write(' Normal Character ');
  91.               currentInputString := currentInputString + keyChar;
  92.               write(keyChar);
  93.             end;
  94.           end;
  95.         {kbUniCode: doNothing();
  96.         kbFnKey: doNothing();
  97.         kbPhys: doNothing();
  98.         kbReleased: doNothing();  }
  99.       end;
  100.     end;
  101. end;
  102.  
  103. // Main Procedures
  104.  
  105. procedure firstRun();
  106. begin
  107.   InitKeyboard;
  108.   InitMouse;
  109.  
  110.   WriteLn('This is a very simple test program!');
  111.   WriteLn('Enter a command:');
  112. end;
  113.  
  114. procedure mainLoop();
  115. begin
  116.   //cmd := getCommand();
  117.   //handleCommand(cmd);
  118.  
  119.   checkKeyboardInput();
  120.  
  121. end;
  122.  
  123. procedure onExit();
  124. begin
  125.   DoneKeyboard;
  126.   DoneMouse;
  127. end;
  128.  
  129.  
  130. begin
  131.   running := True;
  132.   GotoXY(WindMinX,WindMaxY);
  133.   firstRun();
  134.  
  135.   while running do
  136.     begin
  137.       mainLoop();
  138.       sleep(10);
  139.     end;
  140.  
  141.   onExit();
  142. end.
  143.  
Lazarus 1.6 - FPC 3.0.0 - x86_64-win64 on  Windows 7

PascalDragon

  • Hero Member
  • *****
  • Posts: 626
  • Compiler Developer
Re: Console Output
« Reply #32 on: January 02, 2019, 11:23:01 pm »
You can't use the video unit for a headless server.  But crt should work. The video unit relies on the video card hardware of the actual machine. Both units are DOS era legacy, though.
But anyway: auto-completion can simply be implemented and should not rely on either of the two units.
*sigh* That's unit Graph you're talking about. The Video unit is for text mode "full screen" interfaces like the text mode IDE.

JoeJoeTV

  • New Member
  • *
  • Posts: 40
Re: Console Output
« Reply #33 on: May 28, 2019, 10:38:40 pm »
So I have found a solution to the problem, by using the video unit:

Using a loop, LockScreenUpdate, UnlockScreenUpdate and some custom functions, it's now pretty easy to create something like this:
(These are pretty simple functions, because for now it was all I needed)
Code: Pascal  [Select]
  1. procedure WriteString(X,Y: Word; text: String; foreColor: Byte = White; backColor: Byte = Black; chrBlink: Boolean = false);
  2. var
  3.   pos: Integer;
  4.   stringLen: Integer;
  5.   I: Integer;
  6.   Attr: Byte;
  7. begin
  8.   pos := ((X-1)+((Y-1)*ScreenWidth));
  9.   stringLen := Length(text);
  10.  
  11.   Attr := foreColor + (backColor shl 4);
  12.   if chrBlink then
  13.     Attr := Attr or Blink;
  14.  
  15.   if (pos + stringLen) > (ScreenWidth * ScreenHeight) then
  16.     begin
  17.       stringLen := (ScreenWidth * ScreenHeight) - pos;
  18.                 end;
  19.  
  20.   for I:=1 to stringLen do
  21.     begin
  22.       VideoBuf^[pos+I-1] := Ord(text[I])+(Attr shl 8);
  23.                 end;
  24.   UpdateScreen(False);
  25. end;
  26.  
  27. procedure ClearLine(line: Word);
  28. var
  29.   linePos: Integer;
  30.   I: Integer;
  31. begin
  32.   linePos := ((line-1)*ScreenWidth);
  33.  
  34.   for I:= 1 to ScreenWidth do
  35.     begin
  36.       VideoBuf^[linePos+(I-1)] := Ord(' ')+($07 shl 8);
  37.                 end;
  38.   UpdateScreen(False);
  39. end;
  40.  

P.S. At the start of the "main" loop is a LockScreenUpdate, then the displayed stuff is changed and at the end UnlockScreenUpdate and UnlockScreen(False) is used.
Lazarus 2.0.4 / FPC 3.0.4 / 32+64bit / Windows 10