Модератор: Модераторы
zub » 25.01.2017 16:27:56
Alex2013 писал(а):Есть идеи что у меня на ноте не все в порядке с совместной работой двух ядер цпу для программ не имеющих заточки на многоядерность ... (То есть ОС(или сам ЦПУ) самостоятельно пытается раскидать "обычный последовательный код " на несколько параллельных потоков ... и вот тут то и возникают "странные сбои" )
Alex2013 » 25.01.2017 16:39:35
Лекс Айрин писал(а):Alex2013 писал(а):Ошибки и глюки в сложных системах неизбежны .
Тогда работа программиста лишена смысла. И все сразу становится печально и безрадостно.
zub писал(а):Alex2013 писал(а):Есть идеи что у меня на ноте не все в порядке с совместной работой двух ядер цпу для программ не имеющих заточки на многоядерность ... (То есть ОС(или сам ЦПУ) самостоятельно пытается раскидать "обычный последовательный код " на несколько параллельных потоков ... и вот тут то и возникают "странные сбои" )
С твоим железно безбажным кодом даже ос справится неможет...
Спорим руки?
http://www.emulator3000.org/rus-e3.htm viewtopic.php?p=108162#p108162
Лекс Айрин » 25.01.2017 16:53:31
Alex2013 писал(а):То есть в 99% процентах любых программных сбоев код можно переписать "эонами вариантов " так чтобы он четко и надежно работал в конкретной среде обитания или опирался только на документированные и рабочие свойства среды.
Alex2013 писал(а):Мой опыт говорит, что тупиковых ситуаций (при верной постановке задачи и нужных знаниях о возможностях среды) не бывает в принципе ! Этим кстати программирование выгодно отличается от прочих ремесел и искусств ...
zub » 25.01.2017 16:58:31
Alex2013 » 25.01.2017 17:13:42
zub писал(а):>>Есть на пример программа Эмулятор-3000
Да мало ли что где есть. Все необъяснимые баги - дело шаловливых ручек.
Давно бы уже сделал пример и вопрос бы снялся
zub » 25.01.2017 17:24:31
Alex2013 » 26.01.2017 01:12:58
Ну очень тупой анимированный тест ( С исходником )
http://www.freepascal.org/docs-html/rtl ... eword.html
понял намекаешь, что размер нужно умножить на 3 ? Но почему с compareword работает ? (вот это уже в самом деле странно размер пикселя совершенно точно три байта ... ) 
но функция все-же работает ! УФ ! // Номер команды по клику
// и определение границ текущей фигуры
Function GetCMDOnClik(X,Y:Longint):Longint;
Type
TLine=Array [0..2] of byte;
Var
B:TBitmap;
T:SizeInt;LineSize,i,YF,Y1,X1:longint;
R:TRect;
PLine,ELine:^TLine;
BP:Byte;
begin
Result:=-1;
If drawlist= Nil then exit;
If drawlist.Count=0 then exit;
B:=TBitmap.Create;
B.SetSize(rf1.PaintBox1.Width,rf1.PaintBox1.Height);
// Что-бы уже наверняка ...
LineSize:=B.RawImage.Description.BytesPerLine;
Bp:=B.RawImage.Description.BitsPerPixel div 8;
Getmem(ELine,LineSize);// ! Эталонная линия
FillChar(ELine^,LineSize,$F2);// Заполнение
CurCanvas:=B.Canvas;
For I:=DrawList.Count-1 downto 0 DO
begin
b.Canvas.Brush.Color:=$f2f2f2;
CurCanvas.FillRect(0,0,b.Width,b.Height);
CurCanvas.Pen.Mode:=pmWhite;// ! Режим создания маски (все рисуется белым )
RF1.FastDrawFig(I,1); //Рисую одну фигуру на чистом битмапе
CurCanvas.Pen.Mode:=pmCopy;
if TLine(b.ScanLine[Y]^)[X*Bp]<>$f2
then
begin
//Дополнительно определение границ
// текущей фигуры
{-------------------}
{Начальные значения "выворачиваю на изнанку" }
R.Left:=b.Width;R.Top:=b.Height; R.Right:=0;R.Bottom:=0;
{========================================}
// от текущей точки сканирую в вниз
for Y1:=Y to b.Height-1 do begin
PLine :=b.ScanLine[Y1];
If CompareByte(PLine^,ELine^,LineSize)<>0 then
//Быстрая проверка на пустую линию
for X1:=0 to b.Width-1 do
if PLine^[X1*Bp]<>$f2 then
begin
If Y1<R.Top then R.Top:=Y1;
If X1<R.Left then R.Left:=x1;
If X1>R.Right then R.Right:=x1;
If Y1>R.Bottom then R.Bottom:=Y1;
end;
end;
// от текущей точки сканирую в вверх
for Y1:=Y downto 0 do begin
PLine :=b.ScanLine[Y1];
If CompareByte(PLine^,ELine^,LineSize)<>0 then
//Быстрая проверка на пустую линию
for X1:=b.Width-1 downto 0 do
if PLine^[X1*Bp]<>$f2 then
begin
If Y1<R.Top then R.Top:=Y1;
If X1<R.Left then R.Left:=x1;
If X1>R.Right then R.Right:=x1;
//If Y1>R.Bottom then R.Bottom:=Y1;
end;
end;
CurRec:=R;
fCurRec:=True;
Result:=I;
break;
end;
end;
CurCanvas:=rf1.PaintBox1.Canvas;
FreeMem(ELine,LineSize);
b.Free;
end;
Всем спасибо ! zub » 26.01.2017 06:37:46
Всем спасибо ! Alex2013 » 26.01.2017 13:40:42
Ладно ладно, признаю, посыпаю голову пеплом и т.д. 
... там тоже "все работало" ) vitaly_l » 26.01.2017 14:53:44
Alex2013 писал(а):Скорость замедленна примерно в 150 раз (иначе вообще ничего заметить нельзя ) а при изменении размеров тормозит не код определения границ а банальная очистка экрана ... Заменить CurCanvas.Clear на закраску "белым квадратом Малевича" (CurCanvas.FillRect(R) в конце цикла) и разница в скорости при изменении размеров сильно уменьшится ...
RF1.FastDrawFig(I,1); //Рисую одну фигуру на чистом битмапе
RF1.ReturnFastRect(I,1); //Возвращает один рект
RF1.FastDrawFig(I,1,aRect); //Возвращает один рект и рисует фигуру
zub » 26.01.2017 20:35:39
Alex2013 писал(а):Зы
Скорость замедленна примерно в 150 раз (иначе вообще ничего заметить нельзя ) а при изменении размеров тормозит не код определения границ а банальная очистка экрана ... Заменить CurCanvas.Clear на закраску "белым квадратом Малевича" (CurCanvas.FillRect(R) в конце цикла) и разница в скорости при изменении размеров сильно уменьшится ...
Alex2013 писал(а):А первый пример, извини "не о чем"
vitaly_l писал(а):почему нельзя дополнить вот таким кодом:
vitaly_l писал(а):либо более практичным вот таким кодом:
vitaly_l » 26.01.2017 20:57:16
zub писал(а):Потому что процедура рисования (у Alex2013 это некий скрипт) должна быть как можно проще, и "трудности" надо решать в "движке", а не в этих процедурах. Сегодня нам понадобился габарит, завтра понадобится еще что-то - снова скрипты модифицировать?
zub » 26.01.2017 21:09:40
Alex2013 » 27.01.2017 17:13:51
// Графика
AddFunction(@DRW_SetFontParam,
'procedure DRW_SetFontParam(C,CB,BUI,FS,FN:String);');
AddFunction(@DRW_GetTextWidth,'Function DRW_GetTextWidth(S:String):longint;');
AddFunction(@DRW_OutText,'Procedure DRW_OutText(X,Y:Longint;S:String);');
AddFunction(@DRW_MoveTo,'Procedure DRW_MoveTo(X,y:LongInt);');
AddFunction(@DRW_LineTo,'Procedure DRW_LineTo(X,y:LongInt);' );
AddFunction(@DRW_Rect,'Procedure DRW_FillRect(X,y,X1,Y1:LongInt);');
AddFunction(@DRW_Rect,'Procedure DRW_Rect(X,y,X1,Y1:LongInt);' );
AddFunction(@DRW_Elips,'Procedure DRW_Elips(X,y,X1,Y1:LongInt);');
AddFunction(@DRW_LINE,'Procedure DRW_Line(X,y,X1,Y1:LongInt);');
AddFunction(@DRW_SetPenColor,'Procedure DRW_SetPenColor(C:Longint);');
AddFunction(@DRW_SetBrushColor,'Procedure DRW_SetBrushColor(C:LongInt);');
AddFunction(@Drw_LoadIMG,'Procedure Drw_LoadIMG(X,Y,x1,y1:LongInt;N:String);');
AddFunction(@DRW_VGradientFill,'Procedure DRW_VGradientFill(X,y,X1,Y1,C1,c2:LongInt);');
AddFunction(@DRW_HGradientFill,'Procedure DRW_HGradientFill(X,y,X1,Y1,C1,c2:LongInt);');
vitaly_l писал(а):zub писал(а):Потому что процедура рисования (у Alex2013 это некий скрипт) должна быть как можно проще, и "трудности" надо решать в "движке", а не в этих процедурах. Сегодня нам понадобился габарит, завтра понадобится еще что-то - снова скрипты модифицировать?
Почему нельзя продублировать функцию?
В изначальном варианте, она будет просто рисовать, а в дубле, будет: и рисовать, и + ещё возвращать рект.
И скорость рисования сохранится и рект можно будет получать из скриптового источника, там - явно проще рект посчитать. Или нет?
Хотя, безусловно, можно сделать отдельную функцию, которая будет возвращать только рект из скриптов.
наверняка в скриптах, все ограничения заданы, типа как в ректе.
.
vitaly_l » 27.01.2017 17:52:11
AddFunction(@DRW_OutText,'Procedure DRW_OutText(X,Y:Longint;S:String);');
AddFunction(@DRW_MoveTo,'Procedure DRW_MoveTo(X,y:LongInt);');
AddFunction(@DRW_LineTo,'Procedure DRW_LineTo(X,y:LongInt);' );
AddFunction(@Drw_LoadIMG,'Procedure Drw_LoadIMG(X,Y,x1,y1:LongInt;N:String);');
AddFunction(@DRW_VGradientFill,'Procedure DRW_VGradientFill(X,y,X1,Y1,C1,c2:LongInt);');
AddFunction(@DRW_HGradientFill,'Procedure DRW_HGradientFill(X,y,X1,Y1,C1,c2:LongInt);');
AddFunction(@DRW_Rect,'Procedure DRW_FillRect(X,y,X1,Y1:LongInt);');
AddFunction(@DRW_Rect,'Procedure DRW_Rect(X,y,X1,Y1:LongInt);' );
AddFunction(@DRW_Elips,'Procedure DRW_Elips(X,y,X1,Y1:LongInt);');
AddFunction(@DRW_LINE,'Procedure DRW_Line(X,y,X1,Y1:LongInt);');
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 252