diff --git a/programs/develop/fp/examples/Makefile.fpc b/programs/develop/fp/examples/Makefile.fpc new file mode 100644 index 0000000000..f282a29a17 --- /dev/null +++ b/programs/develop/fp/examples/Makefile.fpc @@ -0,0 +1,42 @@ +[target] +programs=example ray + +[default] +target=win32 +cpu=i386 + +[compiler] +options=-dKOLIBRI +unittargetdir=build +targetdir=bin +sourcedir=src + +[prerules] +ifdef KFPCDIR +override KFPCDIR:=$(subst \,/,$(KFPCDIR)) +ifeq ($(wildcard $(KFPCDIR)/bin),) +override KFPCDIR=wrong +endif +else +override KFPCDIR=wrong +endif + +ifeq ($(KFPCDIR),wrong) +$(error The KFPCDIR environment is wrong) +endif + +#UNITSDIR:=$(wildcard $(FPCDIR)/units/$(CPU_TARGET)-kolibri) +UNITSDIR:=$(wildcard $(KFPCDIR)/units) +KOSEXT=.kex +EXE2KEX=$(KFPCDIR)/bin/exe2kos + +[rules] +ifneq ($(TARGET_PROGRAMS),) +KOSFILES=$(addsuffix $(KOSEXT),$(TARGET_PROGRAMS)) +endif + +fpc_all: $(KOSFILES) + +%$(KOSEXT): %$(EXEEXT) + @$(EXE2KEX) $(COMPILER_TARGETDIR)/$^ $(COMPILER_TARGETDIR)/$@ + @$(DEL) $(COMPILER_TARGETDIR)/$^ diff --git a/programs/develop/fp/examples/_build.bat b/programs/develop/fp/examples/_build.bat deleted file mode 100644 index a0a69b9c55..0000000000 --- a/programs/develop/fp/examples/_build.bat +++ /dev/null @@ -1,21 +0,0 @@ -@echo off - -set NAME=%1 -set NAMEEXE=%NAME%.exe -set NAMEKEX=%NAME%.kex - -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% %NAMEKEX% -del %NAMEEXE% -move %NAMEKEX% bin -goto end - -:error -echo An error occured while building %NAME% - -:end diff --git a/programs/develop/fp/examples/example.bat b/programs/develop/fp/examples/example.bat deleted file mode 100644 index 80564a1ffe..0000000000 --- a/programs/develop/fp/examples/example.bat +++ /dev/null @@ -1 +0,0 @@ -@_build example diff --git a/programs/develop/fp/examples/ray.bat b/programs/develop/fp/examples/ray.bat deleted file mode 100644 index 0d97e52f8a..0000000000 --- a/programs/develop/fp/examples/ray.bat +++ /dev/null @@ -1 +0,0 @@ -@call _build.bat ray diff --git a/programs/develop/fp/examples/readme-ru.txt b/programs/develop/fp/examples/readme-ru.txt index 224e3ff229..a564b629c7 100644 --- a/programs/develop/fp/examples/readme-ru.txt +++ b/programs/develop/fp/examples/readme-ru.txt @@ -1 +1,21 @@ -Для начала необхожимо собрать RTL и утилиту exe2kos. +Для начала необхожимо собрать RTL (../rtl/build.sh или ..\rtl\build.bat) и +утилиту exe2kos (../utils/exe2kos/build.sh или ..\utils\exe2kos\exe2kos.bat). +Убедитесь что, относительно данной папки, существуют файл ../bin/exe2kos для +Linux или ..\bin\exe2kos.exe для Windows. Так же убедитесь что существует не +пустая директория ../units/rtl для Linux или ..\units\rtl для Windows. + +Переменная окружения FPCDIR должна указывать на папку с FreePascal (путь +указывается без завершающего слэша или обратного слэша). + +Переменная окружения KFPCDIR должна указывать на папку с проектом KolibriOS +FreePascal (путь указывается без завершающего слэша или обратного слэша). В этой +папке должны находиться такие директории: bin, examples, rtl, units, utils. + +После этого выполните следующие команды в данной папке (без знака $ и пробела +после него): +$ fpcmake -Twin32 +$ make + +Если вы все сделаи правильно, то в папке bin появятся исполняемые файлы с +расширением kex. +build - временная папка, используемая при сборке, можете удалить её. \ No newline at end of file diff --git a/programs/develop/fp/examples/example.pp b/programs/develop/fp/examples/src/example.pp similarity index 52% rename from programs/develop/fp/examples/example.pp rename to programs/develop/fp/examples/src/example.pp index 6bcd2f73e5..0884e51a37 100644 --- a/programs/develop/fp/examples/example.pp +++ b/programs/develop/fp/examples/src/example.pp @@ -4,37 +4,36 @@ {$mode objfpc} {$smartlink on} -{$apptype console} - -{ На данный момент рассматривается выполнение прилодения только как консольное, - т.е. директива console обязательна, поведение программы при отсутствии этой - директивы предопределить нельзя. Гарантированно нельзя использовать функции - Write, WriteLn, Read, ReadLn относительно стандартной консоли ввода/вывода. -} +{$apptype gui} program Example; { Все функции имеющие в своем имени префикс 'kos_' являются платформозависимыми - и реализованы только под KolibriOS. Их использование в любых программных + и реализованы только для KolibriOS. Их использование в любых программных приложениях категорически не рекомендовано, выносите все методы, использующие - эти функции, в отдельные модули (и используйте необходимые абстракции). -} + эти функции, в отдельные модули (и используйте необходимые абстракции). } + procedure DoPaint; { Вывод содержимого окна приложения } begin kos_begindraw(); - {определение параметров окна} + + { определение параметров окна } kos_definewindow(200, 200, 200, 50, $23AABBCC); - {kos_definewindow не имеет параметра для вывода заголовка, - делаем это отдельной функцией kos_setcaption} - {отображение заголовка окна} + + { kos_definewindow не имеет параметра для вывода заголовка, + делаем это отдельной функцией kos_setcaption } + + { отображение заголовка окна } kos_setcaption('ПРИМЕР ПРОГРАММЫ'); - {вывод сообщения} + + { вывод сообщения } kos_drawtext(3, 8, 'Нажмите любую клавишу...'); kos_enddraw(); end; + procedure DoKey; { Обработка события нажатия клавиши } var @@ -42,11 +41,13 @@ var Notes: array[0..3] of Byte; begin Key := kos_getkey(); - {настраиваем буфер для нот} + + { настраиваем буфер для нот } Notes[0] := $90; Notes[1] := Key shr 8; Notes[2] := $00; - {воспроизводим} + + { воспроизводим } kos_speaker(@Notes); end; @@ -56,9 +57,10 @@ function DoButton: Boolean; var Button: DWord; begin - {получить код нажатой кливиши} + { получить код нажатой кливиши } Button := kos_getbutton(); - {если [x], то вернуть ложь, а значит спровоцировать закрытие приложения} + + { если [x], то вернуть ложь, а значит спровоцировать закрытие приложения } Result := Button <> 1; end; @@ -67,35 +69,30 @@ function ProcessMessage: Boolean; { Ожидание и обработка событий. @return: Возвращает False, если было событие к завершению приложения. - @rtype: True или False } + @rtype : True или False } var Event: DWord; begin Result := True; - {ожидаем события от системы} + + { ожидаем события от системы } Event := kos_getevent(); case Event of - SE_PAINT : DoPaint; {перерисовка окна} - SE_KEYBOARD: DoKey; {событие от клавиатуры} - SE_BUTTON : Result := DoButton; {собыие от кнопки, может определить - завершение приложения, если вернет False} + SE_PAINT : DoPaint; { перерисовка окна } + SE_KEYBOARD: DoKey; { событие от клавиатуры } + SE_BUTTON : Result := DoButton; { событие от кнопки, может определить + завершение приложения, если вернет False } end; end; -procedure MainLoop; { Главный цикл приложения } var ThreadSlot: TThreadSlot; begin - {настраиваем события, которые мы готовы обрабатывать} + { настраиваем события, которые мы готовы обрабатывать } kos_maskevents(ME_PAINT or ME_KEYBOARD or ME_BUTTON); - {обработка событий} + + { обработка событий } while ProcessMessage do; -end; - - -begin - WriteLn('Look for a new window, I''m just a konsole ;-)'); - MainLoop; end. diff --git a/programs/develop/fp/examples/ray.pp b/programs/develop/fp/examples/src/ray.pp similarity index 100% rename from programs/develop/fp/examples/ray.pp rename to programs/develop/fp/examples/src/ray.pp diff --git a/programs/develop/fp/rtl/Makefile.fpc b/programs/develop/fp/rtl/Makefile.fpc new file mode 100644 index 0000000000..c58a9e2b29 --- /dev/null +++ b/programs/develop/fp/rtl/Makefile.fpc @@ -0,0 +1,67 @@ +# +# Makefile.fpc for Free Pascal KolibriOS RTL +# + +[package] +main=rtl + +[target] +loaders=$(LOADERS) +units=system objpas buildrtl +#implicitunits=sysinitpas sysinitcyg sysinitgprof \ +# ctypes strings \ +# lineinfo lnfodwrf heaptrc matrix \ +# windows winsock winsock2 initc cmem dynlibs signals \ +# dos crt objects messages \ +# rtlconsts sysconst sysutils math types \ +# strutils dateutils varutils variants typinfo fgl classes \ +# convutils stdconvs cpu mmx charset ucomplex getopts \ +# winevent sockets printer \ +# video mouse keyboard fmtbcd \ +# winsysut sharemem + +#rsts=math varutils typinfo variants classes dateutils sysconst + +[require] +nortl=y + +[install] +fpcpackage=y + +[default] +target=win32 +cpu=i386 + +[compiler] +unittargetdir=../units/rtl +includedir=$(INC) $(PROCINC) +sourcedir=$(INC) $(PROCINC) + +[prerules] +RTL=$(FPCDIR)/rtl +INC=$(RTL)/inc +PROCINC=$(RTL)/$(CPU_TARGET) +OBJPASDIR=$(RTL)/objpas + +[rules] +.NOTPARALLEL: +SYSTEMPPU=$(addsuffix $(PPUEXT),system) + +include $(INC)/makefile.inc +SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) + +include $(PROCINC)/makefile.cpu +SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) + +SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) + +# Unit specific rules + +system$(PPUEXT): system.pp $(SYSDEPS) + $(COMPILER) -Us -Sg system.pp + +objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp + +buildrtl$(PPUEXT): buildrtl.pp system$(PPUEXT) objpas$(PPUEXT) + $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(OBJPASDIR)/classes -Fu$(PROCINC) -I$(OBJPASDIR) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl diff --git a/programs/develop/fp/rtl/build.bat b/programs/develop/fp/rtl/build.bat index eb13f596b1..0d77aaecf5 100644 --- a/programs/develop/fp/rtl/build.bat +++ b/programs/develop/fp/rtl/build.bat @@ -1,21 +1,3 @@ @echo off - -set FPRTL={FreePascal RTL source code, example c:\fp\src\rtl} -set INCS=-Fi%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas;%FPRTL%\objpas\sysutils;%FPRTL%\objpas\classes -set UNTS=-Fu%FPRTL%\inc;%FPRTL%\i386;%FPRTL%\objpas -set BUILDPATH=..\units -set FPCARGS=-n -Twin32 -Sge5 -O3pPENTIUM3 -CfSSE -di386 -FU%BUILDPATH% %INCS% %UNTS% - -fpc system.pp -Us %FPCARGS% -if errorlevel 1 goto error - -fpc %FPRTL%\objpas\objpas.pp %FPCARGS% -if errorlevel 1 goto error - -fpc buildrtl.pp %FPCARGS% -if errorlevel 0 goto end - -:error -echo An error occured while building RTL - -:end +fpcmake -Twin32 +make \ No newline at end of file diff --git a/programs/develop/fp/rtl/build.sh b/programs/develop/fp/rtl/build.sh new file mode 100755 index 0000000000..a6ec0f97ef --- /dev/null +++ b/programs/develop/fp/rtl/build.sh @@ -0,0 +1,3 @@ +#!/bin/sh +fpcmake -Twin32 +make \ No newline at end of file diff --git a/programs/develop/fp/rtl/sysfile.inc b/programs/develop/fp/rtl/sysfile.inc index e6dcbc486f..dbc880777f 100644 --- a/programs/develop/fp/rtl/sysfile.inc +++ b/programs/develop/fp/rtl/sysfile.inc @@ -152,5 +152,8 @@ begin end; if InOutRes <> 0 then + begin FreeMem(KosFile); + FileRec(f).Handle := DWord(-1); + end; end; diff --git a/programs/develop/fp/rtl/system.pp b/programs/develop/fp/rtl/system.pp index 923e535641..a7324032e4 100644 --- a/programs/develop/fp/rtl/system.pp +++ b/programs/develop/fp/rtl/system.pp @@ -1,4 +1,4 @@ -{cp866} +{utf8} unit System; {$i _defines.inc} @@ -56,16 +56,16 @@ begin begin while Args^ <> #0 do begin - {Пропустить лидирующие пробелы} + {╨Я╤А╨╛╨┐╤Г╤Б╤В╨╕╤В╤М ╨╗╨╕╨┤╨╕╤А╤Г╤О╤Й╨╕╨╡ ╨┐╤А╨╛╨▒╨╡╨╗╤Л} while Args^ in [#1..#32] do Inc(Args); if Args^ = #0 then Break; - {Запомнить указатель на параметр} + {╨Ч╨░╨┐╨╛╨╝╨╜╨╕╤В╤М ╤Г╨║╨░╨╖╨░╤В╨╡╨╗╤М ╨╜╨░ ╨┐╨░╤А╨░╨╝╨╡╤В╤А} SetLength(Ptrs, Argc); Ptrs[Argc - 1] := Args; Inc(Argc); - {Пропустить текущий параметр} + {╨Я╤А╨╛╨┐╤Г╤Б╤В╨╕╤В╤М ╤В╨╡╨║╤Г╤Й╨╕╨╣ ╨┐╨░╤А╨░╨╝╨╡╤В╤А} InQuotes := False; while (Args^ <> #0) and (not (Args^ in [#1..#32]) or InQuotes) do begin @@ -73,7 +73,7 @@ begin Inc(Args); end; - {Установить окончание параметра} + {╨г╤Б╤В╨░╨╜╨╛╨▓╨╕╤В╤М ╨╛╨║╨╛╨╜╤З╨░╨╜╨╕╨╡ ╨┐╨░╤А╨░╨╝╨╡╤В╤А╨░} if Args^ in [#1..#32] then begin Args^ := #0; @@ -81,12 +81,12 @@ begin end; end; end; - Argv := GetMem(Argc * SizeOf(PChar)); {XXX: память не освобождается} + Argv := GetMem(Argc * SizeOf(PChar)); {XXX: ╨┐╨░╨╝╤П╤В╤М ╨╜╨╡ ╨╛╤Б╨▓╨╛╨▒╨╛╨╢╨┤╨░╨╡╤В╤Б╤П} Argv[0] := PKosHeader(0)^.path; for I := 1 to Argc - 1 do begin Argv[I] := Ptrs[I - 1]; - {Исключить кавычки из строки} + {╨Ш╤Б╨║╨╗╤О╤З╨╕╤В╤М ╨║╨░╨▓╤Л╤З╨║╨╕ ╨╕╨╖ ╤Б╤В╤А╨╛╨║╨╕} Args := Argv[I]; L := 0; while Args^ <> #0 do begin Inc(Args); Inc(L); end; @@ -118,7 +118,7 @@ end; procedure Randomize; begin - randseed := 0; {GetTickCount()} + randseed := kos_timecounter(); end; const @@ -136,7 +136,6 @@ begin end; {$i kos_stdio.inc} -{-$i kos_term.inc} procedure SysInitStdIO; begin @@ -158,15 +157,15 @@ begin begin if ExitCode <> 0 then begin - {XXX: обязательное условие на однопоточный Konsole} + {XXX: ╨╛╨▒╤П╨╖╨░╤В╨╡╨╗╤М╨╜╨╛╨╡ ╤Г╤Б╨╗╨╛╨▓╨╕╨╡ ╨╜╨░ ╨╛╨┤╨╜╨╛╨┐╨╛╤В╨╛╤З╨╜╤Л╨╣ Konsole} Write(StdErr, '[Error #', ExitCode,', press any key]'); - {ожидать нажатия клавиши} + {╨╛╨╢╨╕╨┤╨░╤В╤М ╨╜╨░╨╢╨░╤В╨╕╤П ╨║╨╗╨░╨▓╨╕╤И╨╕} Konsole.KeyPressed; while Konsole.KeyPressed = 0 do kos_delay(2); - {TODO: исправить косяк при перерисовке Konsole} - {это невозможно, так как куча освобождается еще до вызова этой процедуры} - {можно написать свой диспетчер памяти, но это сложно} - {а если в Konsole использовать выделение памяти напрямую через KosAPI?!} + {TODO: ╨╕╤Б╨┐╤А╨░╨▓╨╕╤В╤М ╨║╨╛╤Б╤П╨║ ╨┐╤А╨╕ ╨┐╨╡╤А╨╡╤А╨╕╤Б╨╛╨▓╨║╨╡ Konsole} + {╤Н╤В╨╛ ╨╜╨╡╨▓╨╛╨╖╨╝╨╛╨╢╨╜╨╛, ╤В╨░╨║ ╨║╨░╨║ ╨║╤Г╤З╨░ ╨╛╤Б╨▓╨╛╨▒╨╛╨╢╨┤╨░╨╡╤В╤Б╤П ╨╡╤Й╨╡ ╨┤╨╛ ╨▓╤Л╨╖╨╛╨▓╨░ ╤Н╤В╨╛╨╣ ╨┐╤А╨╛╤Ж╨╡╨┤╤Г╤А╤Л} + {╨╝╨╛╨╢╨╜╨╛ ╨╜╨░╨┐╨╕╤Б╨░╤В╤М ╤Б╨▓╨╛╨╣ ╨┤╨╕╤Б╨┐╨╡╤В╤З╨╡╤А ╨┐╨░╨╝╤П╤В╨╕, ╨╜╨╛ ╤Н╤В╨╛ ╤Б╨╗╨╛╨╢╨╜╨╛} + {╨░ ╨╡╤Б╨╗╨╕ ╨▓ Konsole ╨╕╤Б╨┐╨╛╨╗╤М╨╖╨╛╨▓╨░╤В╤М ╨▓╤Л╨┤╨╡╨╗╨╡╨╜╨╕╨╡ ╨┐╨░╨╝╤П╤В╨╕ ╨╜╨░╨┐╤А╤П╨╝╤Г╤О ╤З╨╡╤А╨╡╨╖ KosAPI?!} end; Close(StdErr); Close(StdOut); diff --git a/programs/develop/fp/rtl/sysutils.pp b/programs/develop/fp/rtl/sysutils.pp index 4eea758eae..5be4231218 100644 --- a/programs/develop/fp/rtl/sysutils.pp +++ b/programs/develop/fp/rtl/sysutils.pp @@ -1,12 +1,13 @@ +{utf8} unit sysutils; {$i _defines.inc} +{$mode objfpc} +{$h+} interface -{$mode objfpc} { force ansistrings } -{$h+} {$DEFINE HAS_SLEEP} {-$DEFINE HAS_OSERROR} @@ -150,7 +151,7 @@ begin fsFromCurrent: Position := FilePos(FileRecordByHandle(Handle)^.F) + FOffset; fsFromEnd: Position := FileSize(FileRecordByHandle(Handle)^.F) + FOffset; end; - {TODO: проверка соответствия [0..filesize]} + {TODO: ╨┐╤А╨╛╨▓╨╡╤А╨║╨░ ╤Б╨╛╨╛╤В╨▓╨╡╤В╤Б╤В╨▓╨╕╤П [0..filesize]} Seek(FileRecordByHandle(Handle)^.F, Position); Result := Position; end; @@ -175,15 +176,16 @@ function FileExists(const FileName: String): Boolean; var F: File; begin + {$i-} Assign(F, FileName); - try - Reset(F); - FileSize(F); + Reset(F); + if IOResult = 0 then + begin Result := True; - except + Close(F); + end else Result := False; - end; - Close(F); + {$i+} end; function DirectoryExists(const Directory: String): Boolean; diff --git a/programs/develop/fp/utils/exe2kos/build.bat b/programs/develop/fp/utils/exe2kos/build.bat new file mode 100644 index 0000000000..44a3cf9b3d --- /dev/null +++ b/programs/develop/fp/utils/exe2kos/build.bat @@ -0,0 +1,5 @@ +@echo off +fpc -Twin32 exe2kos.pp +del *.o +del *.ppu +move exe2kos.exe ..\..\bin \ No newline at end of file diff --git a/programs/develop/fp/utils/exe2kos/build.sh b/programs/develop/fp/utils/exe2kos/build.sh new file mode 100755 index 0000000000..7ea9aa6db6 --- /dev/null +++ b/programs/develop/fp/utils/exe2kos/build.sh @@ -0,0 +1,5 @@ +#!/bin/sh +fpc -Tlinux exe2kos.pp && +rm *.o && +rm *.ppu && +mv exe2kos ../../bin \ No newline at end of file