[FP] changes in RTL, first example

git-svn-id: svn://kolibrios.org@623 a494cfbc-eb01-0410-851d-a64ba20cac60

programs/develop/fp/examples/_build.bat

@@ -0,0 +1,20 @@
+@echo off
+
+set NAME=%1
+set NAMEEXE=%NAME%.exe
+set NAMEKOS=%NAME%
+
+set BUILD=-FUbuild
+set UNTS=-Fu..\units
+
+fpc %NAME%.pp -n -Twin32 -Se5 -XXs -Sg -O3pPENTIUM3 -CfSSE -WB0 %BUILD% %UNTS%
+if errorlevel 1 goto error
+
+..\exe2kos\exe2kos.exe %NAMEEXE% %NAMEKOS%.kex
+del %NAMEEXE%
+goto end
+
+:error
+echo An error occured while building %NAME%
+
+:end

programs/develop/fp/examples/example.bat

@@ -0,0 +1 @@
+@_build example

programs/develop/fp/examples/example.pp

@@ -0,0 +1,99 @@
+{$codepage cp866}
+{$mode objfpc}
+{$smartlink on}
+{$apptype console}
+
+{ <EFBFBD>  ¤ ­­ë© ¬®¬¥­â à áᬠâਢ ¥âáï ¢ë¯®«­¥­¨¥ ¯à¨«®¤¥­¨ï ⮫쪮 ª ª ª®­á®«ì­®¥,
+  â.¥. ¤¨à¥ªâ¨¢  concole ®¡ï§ â¥«ì­ , ¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë ¯à¨ ®âáãâá⢨¨ í⮩
+  ¤¨à¥ªâ¨¢ë ¯à¥¤®¯à¥¤¥«¨âì ­¥«ì§ï. ƒ à ­â¨à®¢ ­­® ­¥«ì§ï ¨á¯®«ì§®¢ âì ä㭪樨
+  Write, WriteLn, Read, ReadLn ®â­®á¨â¥«ì­® áâ ­¤ àâ­®© ª®­á®«¨ ¢¢®¤ /¢ë¢®¤ .
+}
+
+program Example;
+
+{ ‚ᥠä㭪樨 ¨¬¥î騥 ¢ ᢮¥¬ ¨¬¥­¨ ¯à¥ä¨ªá 'kos_' ïîâáï ¯« âä®à¬®§ ¢¨á¨¬ë¬¨
+  ¨ ॠ«¨§®¢ ­ë ⮫쪮 ¯®¤ KolibriOS. ˆå ¨á¯®«ì§®¢ ­¨¥ ¢ «î¡ëå ¯à®£à ¬¬­ëå
+  ¯à¨«®¦¥­¨ïå ª â¥£®à¨ç¥áª¨ ­¥ ४®¬¥­¤®¢ ­®, ¢ë­®á¨â¥ ¢á¥ ¬¥â®¤ë, ¨á¯®«ì§ãî騥
+  í⨠ä㭪樨, ¢ ®â¤¥«ì­ë¥ ¬®¤ã«¨ (¨ ¨á¯®«ì§ã©â¥ ­¥®¡å®¤¨¬ë¥  ¡áâࠪ樨).
+}
+
+procedure DoPaint;
+{ ‚뢮¤ ᮤ¥à¦¨¬®£® ®ª­  ¯à¨«®¦¥­¨ï }
+begin
+  kos_begindraw();
+  {®¯à¥¤¥«¥­¨¥ ¯ à ¬¥â஢ ®ª­  (0)}
+  kos_definewindow(200, 200, 200, 50, $23AABBCC);
+  {kos_definewindow ­¥ ¨¬¥¥â ¯ à ¬¥âà  ¤«ï ¢ë¢®¤  § £®«®¢ª ,
+   ¤¥« ¥¬ íâ® ®â¤¥«ì­®© ä㭪樥©}
+  {kos_setcaption, ®â®¡à ¦¥­¨¥ § £®«®¢ª  ®ª­  (71.1)}
+  kos_setcaption('<27><>ˆŒ…<C592> <20><>Žƒ<C5BD>€ŒŒ›');
+  {¢ë¢®¤ á®®¡é¥­¨ï (4)}
+  kos_drawtext(3, 8, '<27> ¦¬¨â¥ «î¡ãî ª« ¢¨èã...');
+  kos_enddraw();
+end;
+
+procedure DoKey;
+{ Ž¡à ¡®âª  ᮡëâ¨ï ­ ¦ â¨ï ª« ¢¨è¨ }
+var
+  Key: DWord;
+  Notes: array[0..3] of Byte;
+begin
+  Key := kos_getkey();
+  {­ áâà ¨¢ ¥¬ ¡ãä¥à ¤«ï ­®â}
+  Notes[0] := $90;
+  Notes[1] := Key shr 8;
+  Notes[2] := $00;
+  {¢®á¯à®¨§¢®¤¨¬}
+  kos_speak(@Notes);
+end;
+
+
+function DoButton: Boolean;
+{ Ž¡à ¡®âª  ᮡëâ¨ï ­ ¦ â¨ï ª­®¯ª¨ GUI }
+var
+ Button: DWord;
+begin
+  {¯®«ãç¨âì ª®¤ ­ ¦ â®© ª«¨ë¨è¨}
+  Button := kos_getbutton();
+  {¥á«¨ X, â® § ¢¥à襭¨¥ ¯à¨«®¦¥­¨ï}
+  Result := Button = 1;
+end;
+
+
+function ProcessMessage: Boolean;
+{ @return: ‚®§¢à é ¥â False, ¥á«¨ ¡ë«® ᮡë⨥ ª § ¢¥à襭¨î ¯à¨«®¦¥­¨ï.
+  @rtype: True ¨«¨ False }
+var
+  Event: DWord;
+begin
+  Result := False;
+  {®¦¨¤ ¥¬ ᮡëâ¨ï ®â á¨á⥬ë}
+  Event := kos_getevent();
+  case Event of
+    SE_PAINT   : DoPaint;  {¯¥à¥à¨á®¢ª  ®ª­ }
+    SE_KEYBOARD: DoKey;    {ᮡë⨥ ®â ª« ¢¨ âãàë}
+    SE_BUTTON  : Result := DoButton; {ᮡ먥 ®â ª­®¯ª¨, ¬®¦¥â ®¯à¥¤¥«¨âì
+                                      § ¢¥à襭¨¥ ¯à¨«®¦¥­¨ï, ¥á«¨ ¢¥à­¥â True}
+  end;
+end;
+
+
+procedure MainLoop;
+{ ƒ« ¢­ë© 横« ¯à¨«®¦¥­¨ï }
+var
+  ThreadSlot: TThreadSlot;
+begin
+  {ᤥ« âì íâ® ®ª­®  ªâ¨¢­ë¬}
+  ThreadSlot := kos_getthreadslot(ThreadID);
+  kos_setactivewindow(ThreadSlot);
+  {­ áâà ¨¢ ¥¬ ᮡëâ¨ï, ª®â®àë¥ ¬ë £®â®¢ë ®¡à ¡ â뢠âì}
+  kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_BUTTON);
+  {£« ¢­ë© 横«}
+  while not ProcessMessage do;
+end;
+
+
+begin
+  WriteLn('Look for a new window, I''m just a konsole, hi mike ;-)');
+  MainLoop;
+end.

programs/develop/fp/examples/readme-ru.txt

@@ -0,0 +1,3 @@
+Codepage: cp866
+
+„«ï ­ ç «  ­¥®¡å®¦¨¬® ᮡà âì RTL ¨ ã⨫¨âã exe2kos.

programs/develop/fp/readme-ru.txt

@@ -1,18 +1,18 @@
-Codepage: koi8-r
+Codepage: cp866
 
-Текущий код адаптирован и проверялся только на FreePascal 2.3.1 (SVN 8373) при
+’¥ªã騩 ª®¤  ¤ ¯â¨à®¢ ­ ¨ ¯à®¢¥àï«áï ⮫쪮 ­  FreePascal 2.3.1 (SVN 8373) ¯à¨
-компиляции из Windows.
+ª®¬¯¨«ï樨 ¨§ Windows.
 
-Для компилирования версии RTL для KolibriOS вам необходимо иметь установленный
+„«ï ª®¬¯¨«¨à®¢ ­¨ï ¢¥àᨨ RTL ¤«ï KolibriOS ¢ ¬ ­¥®¡å®¤¨¬® ¨¬¥âì ãáâ ­®¢«¥­­ë©
-у себя FreePascal с исходными кодами RTL указанной выше версии. Откройте файл
+ã ᥡï FreePascal á ¨á室­ë¬¨ ª®¤ ¬¨ RTL 㪠§ ­­®© ¢ëè¥ ¢¥àᨨ. Žâªà®©â¥ ä ©«
-rtl/build.bat и укажите в переменной окружения FPRTL точный путь к исходному
+rtl/build.bat ¨ 㪠¦¨â¥ ¢ ¯¥à¥¬¥­­®© ®ªà㦥­¨ï FPRTL â®ç­ë© ¯ãâì ª ¨á室­®¬ã
-коду оригинальной RTL. Например, если FreePascal установлен в c:\fp, то
+ª®¤ã ®à¨£¨­ «ì­®© RTL. <20> ¯à¨¬¥à, ¥á«¨ FreePascal ãáâ ­®¢«¥­ ¢ c:\fp, â®
-вероятнее всего исходный код находится в c:\fp\src\rtl. Этот путь и нужно
+¢¥à®ïâ­¥¥ ¢á¥£® ¨á室­ë© ª®¤ ­ å®¤¨âáï ¢ c:\fp\src\rtl. <20>â®â ¯ãâì ¨ ­ã¦­®
-указать. Предпологается что иерархия директорий исходников FreePascal сохранена
+㪠§ âì. <20>।¯®«®£ ¥âáï çâ® ¨¥à àå¨ï ¤¨à¥ªâ®à¨© ¨á室­¨ª®¢ FreePascal á®åà ­¥­ 
-точно такой же как в репозитарии FreePascal'я.
+â®ç­® â ª®© ¦¥ ª ª ¢ ९®§¨â à¨¨ FreePascal'ï.
 
-После изменения rtl/build.bat запустите этот командный файл на выполнение. После
+<EFBFBD>®á«¥ ¨§¬¥­¥­¨ï rtl/build.bat § ¯ãáâ¨â¥ íâ®â ª®¬ ­¤­ë© ä ©« ­  ¢ë¯®«­¥­¨¥. <20>®á«¥
-завершения работы этого файла в папке ./units должны появить модули и объектные
+§ ¢¥à襭¨ï à ¡®âë í⮣® ä ©«  ¢ ¯ ¯ª¥ ./units ¤®«¦­ë ¯®ï¢¨âì ¬®¤ã«¨ ¨ ®¡ê¥ªâ­ë¥
-файлы RTL.
+ä ©«ë RTL.
 
-Как теперь собирать программы я опишу позже.
+Š ª ⥯¥àì ᮡ¨à âì ¯à®£à ¬¬ë ï ®¯¨èã ¯®§¦¥.

programs/develop/fp/rtl/kos.inc

@@ -20,6 +20,7 @@ asm
   movl  style, %edx
   decl  %ebx  {㬥­ìè¨âì è¨à¨­ã ­  1}
   decl  %ecx  {㬥­ìè¨âì ¢ëá®âã ­  1}
+  andl  $0xEFFFFFFF, %edx
   int   $0x40
   popl %edi
   popl %esi
@@ -591,6 +592,24 @@ asm
 end;
 
 
+{ Sound }
+
+function kos_speak(notes: Pointer): Boolean; assembler; register;
+asm
+  pushl %esi
+  pushl %ebx
+  movl  $55, %esi
+  movl  %esi, %ebx
+  xchgl %eax, %esi
+  int   $0x40
+  {eax = 55 - ®è¨¡ª }
+  andl  $1, %eax
+  popl  %ebx
+  popl  %esi
+  xorb  $1, %al
+end;
+
+
 { Work with hardware }
 
 function kos_readport(index: DWord): DWord; assembler; register;

programs/develop/fp/rtl/kosh.inc

@@ -140,6 +140,10 @@ function kos_rewritefile(kosfile: PKosFile; var writed: Longint): DWord;
 function kos_writefile(kosfile: PKosFile; var writed: Longint): DWord;
 function kos_fileinfo(kosfile: PKosFile): DWord;
 
+{ Sound }
+
+function kos_speak(notes: Pointer): Boolean;
+
 { Work with hardware }
 function kos_readport(index: DWord): DWord;
 procedure kos_writeport(index, value: DWord);