Код паровоза на мосхабе

nabbla1 — 21.08.2024

var
  engine, bgnd, wheel, connector, rod, piston: TSVGPath;
  enginePos, Wheel1Pos, Wheel2Pos, Wheel3Pos, ConnectorPos, RodPos, PistonPos: TNonCommDualComplexNum;
  png: TPngImage;

procedure TForm1.FormCreate(Sender: TObject);
begin
  engine := TSVGpath.Create;
  engine.LoadFromSVGFile('engine.svg');
  engine.SetPlane(1);
  enginePos.Assign(1,0,-252,256);

  wheel := TSVGpath.Create;
  wheel.LoadFromSVGFile('wheel3.svg');
  wheel.SetPlane(1);
  Wheel1Pos.Assign(1,0,-189/2,-289.412/2);
  Wheel2Pos.Assign(1,0,-189/2,-127.865/2);
  Wheel3Pos.Assign(1,0,-189/2,33.659/2);

  connector := TSVGpath.Create;
  connector.LoadFromSVGfile('connector.svg');
  connector.SetPlane(1);
  connectorPos.Assign(1,0,-27.15/2,0);

  rod := TSVGpath.Create;
  rod.LoadFromSVGFile('rod.svg');
  rod.SetPlane(1);
  rodPos.Assign(1,0,-27.15/2,0);

  piston := TSVGpath.Create;
  piston.LoadFromSVGfile('piston.svg');
  piston.SetPlane(1);
  pistonPos.Assign(1,0,-157/2,123/2);

  png := TPngImage.CreateBlank(COLOR_GRAYSCALE, 1, 1024, 768);
end;

procedure TForm1.Redraw;
begin
  png.Canvas.FillRect(Rect(0,0,1024,768));
  engine.Draw(png.Canvas, enginePos);

  wheel.Draw(png.Canvas, enginePos*wheel1pos);
  wheel.Draw(png.Canvas, enginePos*wheel2pos);
  wheel.Draw(png.Canvas, enginePos*wheel3pos);

  connector.Draw(png.Canvas, enginePos * wheel2pos * connectorPos);

  rod.Draw(png.Canvas, enginePos * wheel2pos * rodPos);

  piston.Draw(png.Canvas, enginePos *pistonpos);

  image1.Picture.Assign(png);
end;

procedure TForm1.btnMakeStepClick(Sender: TObject);
var rotation: TNonCommDualComplexNum;
    angle: Real;
    rodAngle: Real;
    endOfRodPos: TNonCommDualComplexNum;
begin
  angle := StrToFloat(txtRotationAngle.Text) * pi /180;
//  rotation.Assign(cos(angle/2), sin(angle/2), 0, 0);
  rotation.Assign(1, angle/2, 0, 0);
//  rotation.Assign(1 - angle*angle/12, angle/2, 0, 0);

  wheel1pos := wheel1pos * rotation;
  wheel2pos := wheel2pos * rotation;
  wheel3pos := wheel3pos * rotation;

    (*
  wheel1pos := rotation * wheel1pos;
  wheel2pos := rotation * wheel2pos;
  wheel3pos := rotation * wheel3pos;
      *)

  wheel1pos.FastNorm;
  wheel2pos.FastNorm;
  wheel3pos.FastNorm;


  rotation.Conjugate;
  connectorPos := connectorPos * rotation;
  connectorPos.FastNorm;


 // rodAngle := angle;  //попробуем, если с коррекцией по вертикали, но без хорошего угла
  rodAngle := angle * (1 - 2 * wheel2pos.c * wheel2pos.s * 21.2/(258.54+21.2));
  //уже весьма недурственно!

  rotation.Assign(1, -rodAngle/2, 0, 0);
  rodPos := rodPos * rotation;
  rodPos.FastNorm;


  //и теперь игра в constraint
  //говорим, что конец этого дышла должен сохранять одну и ту же координату.
  endOfRodPos.Assign(0,1,251,-62); //относительно центра дышла, которым считаем его крепление к колесу.
  rotation := wheel2pos * rodPos; //сложение двух движений - вращение колеса и положение дышла на нём
  endOfRodPos := NonCommDualComplexRotate(endOfRodPos, rotation);
  //должны получить y-координату 154. 
  //т.е если оно отклонилось, то применим доп. поворот который довернёт его примерно куда надо!
  angle := (endOfRodPos.y - 154) / 258.54;
  rotation.Assign(1, -angle/2, 0, 0);
  rodPos := rodPos * rotation;
  rodPos.FastNorm;

  pistonPos.Assign(1, 0, -157/2, endOfRodPos.x/2);

  redraw;
end;

type TNonCommDualComplexNum = record
  c, s, x, y: Real; //косинус, синус и смещение по двум осям
  procedure Assign(vc,vs,vx,vy: Real);
  procedure Conjugate;  //заменить на сопряжённое, на месте
  procedure Invert;     //заменить на обратную величину, на месте
  procedure FastNorm; //нормализация через метод Ньютона
  class operator Add(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
  class operator Subtract(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
  class operator Multiply(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
  class operator Multiply(Left: TNonCommDualComplexNum; Right: Real): TNonCommDualComplexNum;
  class operator Divide(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
  class operator Divide(Left: TNonCommDualComplexNum; Right: Real): TNonCommDualComplexNum;
end;

function NonCommDualComplexLn(value: TNonCommDualComplexNum): TNonCommDualComplexNum;
function NonCommDualComplexExp(value: TNonCommDualComplexNum): TNonCommDualComplexNum;
function NonCommDualComplexRotate(vec, transf: TNonCommDualComplexNum): TNonCommDualComplexNum;

function sinc(x: Real): Real;
function invsinc(x: Real): Real;

const NonCommDualCmplxUnity: TNonCommDualComplexNum = (c: 1; s: 0; x: 0; y: 0);

class operator TNonCommDualComplexNum.Add(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
begin
  Result.c := Left.c + Right.c;
  Result.s := Left.s + Right.s;
  Result.x := Left.x + Right.x;
  Result.y := Left.y + Right.y;
end;

class operator TNonCommDualComplexNum.Subtract(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
begin
  Result.c := Left.c - Right.c;
  Result.s := Left.s - Right.s;
  Result.x := Left.x - Right.x;
  Result.y := Left.y - Right.y;
end;

class operator TNonCommDualComplexNum.Multiply(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
begin
  Result.c := Left.c * Right.c - Left.s * Right.s;
  Result.s := Left.c * Right.s + Left.s * Right.c;
  Result.x := Left.c * Right.x - Left.s * Right.y + Right.c * Left.x + Right.s * Left.y;
  Result.y := Left.c * Right.y + Left.s * Right.x + Right.c * Left.y - Right.s * Left.x;
end;

//здесь совершенно убийственная была выкладка для коммутирующих дуал комплекс.
//зато простейшая для некоммут!
procedure TNonCommDualComplexNum.Conjugate;  //превратить в сопряжённое число
begin
  s := -s;
  x := -x;
  y := -y;
end;

//здесь вся сложность убиралась внутрь Conjugate, оставшееся довольно очевидно.
procedure TNonCommDualComplexNum.Invert;
var invabssqr: Real;
begin
  invabssqr := 1/(Sqr(c) + Sqr(s));
  Conjugate;
  c := c * invabssqr;
  s := s * invabssqr;
  x := x * invabssqr;
  y := y * invabssqr;
end;

class operator TNonCommDualComplexNum.Multiply(Left: TNonCommDualComplexNum;
  Right: Real): TNonCommDualComplexNum;
begin
  Result.c := Left.c * Right;
  Result.s := Left.s * Right;
  Result.x := Left.x * Right;
  Result.y := Left.y * Right;
end;

class operator TNonCommDualComplexNum.Divide(Left, Right: TNonCommDualComplexNum): TNonCommDualComplexNum;
begin
  Right.Invert;
  Result := Left * Right;
end;

class operator TNonCommDualComplexNum.Divide(Left: TNonCommDualComplexNum; Right: Real): TNonCommDualComplexNum;
begin
  Right := 1 / Right;
  Result.c := Left.c * Right;
  Result.s := Left.s * Right;
  Result.x := Left.x * Right;
  Result.y := Left.y * Right;
end;

procedure TNonCommDualComplexNum.FastNorm;
var norm: Real;
begin
  norm := Sqr(c) + Sqr(s);
  norm := 1.5-0.5*norm;
  c := c * norm;
  s := s * norm;
  x := x * norm;
  y := y * norm;
end;

function NonCommDualComplexRotate(vec, transf: TNonCommDualComplexNum): TNonCommDualComplexNum;
begin
  Result := transf * vec;
  transf.Conjugate;
  Result := Result * transf;
end;

type
  TPointArray = array [0..MaxInt div SizeOf(TPoint) - 1] of TPoint;
  PPointArray = ^TPointArray;

procedure TSvgPath.Draw(canvas: TCanvas; transform: TNonCommDualComplexNum);
var seq, i, cur: Integer;
    conj, moved: TNonCommDualComplexNum;
begin
  conj := transform;
  conj.Conjugate;

  for i := 0 to fCount-1 do
    fTransformedPoints[i] := transform * fPoints[i] * conj;

  seq := 0; //номер точки в текущей последовательности
  for i := 0 to fBezierCount-1 do begin
    cur := fBezierIndices[i];
    if cur <> -1 then begin //нормальное значение
      moved := fTransformedPoints[cur];
      fBezierPoints[seq].X := Round(moved.x);
      fBezierPoints[seq].Y := Round(moved.y);
      inc(seq);
    end
    else begin
      canvas.PolyBezier(Slice(PPointArray(@fBezierPoints[0])^, seq));
      seq := 0;
    end;
  end;
  canvas.PolyBezier(Slice(PPointArray(@fBezierPoints[0])^, seq));
end;

type  TParsingState = (psIdle, psIntegerPart, psDecimalPart);

procedure TSvgPath.AppendFromString(str: AnsiString);
var curCmd: AnsiChar; //если команда та же самая, то она может повторно и не указываться!
    isRelative: Boolean;
    argNum, argsTotal: Integer;  //сколько уже аргументов прочитано по текущей команде
    i: Integer;
    state: TParsingState;
    curNumber: Real;  //число, которое по циферке собираем
    curSign: Real;
    curCoordX, curCoordY: Real; //чтобы преобразовать отн координаты в абс
    bearing: Real;
    co, si: Real;
    divider: Real;
    FirstPointOfThisBatch: Boolean;
    zIndex: Integer; //в какой индекс вернуться по команде Z
  procedure ProcessCmd;
  begin
    //по умолчанию считаем, что команда не изменится (искл: M/m),
    //аргументы снова начинаются с нуля,
    //и аргументы абсолютные
    argNum := 0;
    isRelative := false;
    case curCmd of
//у меня чувство, что придётся каждую команду всё-таки отдельно рассмотреть, всё у них через задницу...
      'M': //MoveTo, с абс. координатами
        begin
          //ожидаем 2 числа, X,Y
          AddBezierIndex(-1); //разрываем текущую фигуру.
          NewPoint; //резервируем место под точку, а запишем когда время придёт
          AddBezierIndex(fCount-1); //начинаем новый PolyBezier, ему нужна начальная точка, это она и будет
          curCmd := 'L';  //вот такой парадокс! Первую точку впишем, не подавимся, а вторая уже как линия должна пойти...
          argsTotal := 2;
          zIndex := fCount-1;
        end;
      'm': //MoveTo, с отн. координатами
        begin
          AddBezierIndex(-1);
          NewPoint;
          AddBezierIndex(fCount-1);
          curCmd := 'l';
          argsTotal := 2;
          zIndex := fCount-1;             
          isRelative := true;
        end;
      'L': //LineTo, произвольная прямая линия с абс координатами
        begin
          AddBezierIndex(fCount-1); //первая контрольная точка совпадает с начальной (которая уже добавлена ранее)
          NewPoint; //резервируем место под конечную точку, туда всё и запишется как придёт время
          AddBezierIndex(fCount-1); //вторая контрольная точка совпадает с конечной (знаем её индекс, вот-вот запишем)
          AddBezierIndex(fCount-1); //конечная точка
          argsTotal := 2;
        end;
      'l': //LineTo, произв прямая линия с отн координатами
        begin
          AddBezierIndex(fCount-1); //первая контрольная точка совпадает с начальной (которая уже добавлена ранее)
          NewPoint; //резервируем место под конечную точку, туда всё и запишется как придёт время
          AddBezierIndex(fCount-1); //вторая контрольная точка совпадает с конечной (знаем её индекс, вот-вот запишем)
          AddBezierIndex(fCount-1); //конечная точка
          argsTotal := 2;
          isRelative := true;
        end;
      'H': //Horizontal, с абс координатами
        begin
          AddBezierIndex(fCount-1); //первая контрольная точка совпадает с начальной
          NewPoint;   //резервируем место под конечную точку
          fPoints[fCount-1].y := fPoints[fCount-2].y;
          AddBezierIndex(fCount-1); //вторая контр совпадает с конечной
          AddBezierIndex(fCount-1); //конечная точка
          argsTotal := 1; //т.е мы записали икс - И УСПОКОИЛИСЬ
        end;
      'h': //Horizontal, с отн координатами
        begin
          AddBezierIndex(fCount-1); //первая контрольная точка совпадает с начальной
          NewPoint;   //резервируем место под конечную точку
          fPoints[fCount-1].y := fPoints[fCount-2].y;
          AddBezierIndex(fCount-1); //вторая контр совпадает с конечной
          AddBezierIndex(fCount-1); //конечная точка
          argsTotal := 1; //т.е мы записали икс - И УСПОКОИЛИСЬ
          isRelative := true;
        end;
      'V': //Vertical, с абс координатами
        begin
          AddBezierIndex(fCount-1); //первая контрольная точка совпадает с начальной
          NewPoint;   //резервируем место под конечную точку
          fPoints[fCount-1].x := fPoints[fCount-2].x;
          AddBezierIndex(fCount-1); //вторая контр совпадает с конечной
          AddBezierIndex(fCount-1); //конечная точка
          argsTotal := 2;
          argNum := 1;  //т.е мы сделали вид, что икс уже записали и сейчас запишем игрек!
        end;
      'v': //vertical, с отн координатами
        begin
          AddBezierIndex(fCount-1); //первая контрольная точка совпадает с начальной
          NewPoint;   //резервируем место под конечную точку
          fPoints[fCount-1].x := fPoints[fCount-2].x;
          AddBezierIndex(fCount-1); //вторая контр совпадает с конечной
          AddBezierIndex(fCount-1); //конечная точка
          argsTotal := 2; //т.е мы записали икс - И УСПОКОИЛИСЬ
          argNum := 1;
          isRelative := true;
        end;
      'C':  //Cube Bezier, кубический Безье с абс координатами
        begin
          NewPoint; //1я упр
          AddBezierIndex(fCount-1);
          NewPoint; //2я упр
          AddBezierIndex(fCount-1);
          NewPoint; //конечная
          AddBezierIndex(fCount-1);
          argsTotal := 6;
        end;
      'c':  //CubeBezier, кубический Безье с отн координатами
        begin
          NewPoint; //1я упр
          AddBezierIndex(fCount-1);
          NewPoint; //2я упр
          AddBezierIndex(fCount-1);
          NewPoint; //конечная
          AddBezierIndex(fCount-1);
          argsTotal := 6;
          isRelative := true;
        end;
    end;
  end;
  //обрабатывали число, циферку за циферкой, но затем увидели что-то ещё и поняли, что число уже завершилось
  //пожалуй, у нас будет трюк с V/H, где мы как будто бы прочитаем лишнее число.
  procedure FinishNumber;
  var offset: Integer;
  begin
    if state <> psIdle then begin
      curNumber := curNumber * curSign;

      if argNum >= argsTotal then begin //вот где нужно озаботиться исполнением очередной команды!
        if  FirstPointOfThisBatch then
          FirstPointOfThisBatch := false
          //пришлось эту переменную вводить на случай, добавляем новый path,
          //который начинается с команды "m", и тогда нужно двинуться относительно (0;0),
          //а если бы мы на fCount опирались, то сдвинулись бы отн. прошлого path, что неправильно
        else begin
          curCoordX := fPoints[fCount-1].x; //последняя точка, выделенная уже исполненной командой
          curCoordY := fPoints[fCount-1].y; //при вызове ProcessCmd зарезервируются новые места!
        end;
        ProcessCmd;
      end;

      if isRelative then
        if argNum AND 1 = 0 then
          curNumber := curNumber + curCoordX * co - curCoordY * si
                  //задел под SVG 2.0, с их командой b (bearing) и "черепашьей графикой". Но сама b пока не реализована.
        else
          curNumber := curNumber + curCoordY * co + curCoordX * si;

      offset := (argsTotal - argNum + 1) shr 1;
      if argNum AND 1 = 0 then //первый, третий, пятый аргумент, т.е по оси X
        fPoints[fCount-offset].x := curNumber
      else
        fPoints[fCount-offset].y := curNumber;

      inc(argNum);
      state := psIdle;
      curSign := 1;
    end;
  end;

begin
  state := psIdle;
  bearing := 0;
  co := 1;
  si := 0;
  curSign := 1;
  curCoordX := 0;
  curCoordY := 0;
  argNum := 0;
  argsTotal := 0;
  FirstPointOfThisBatch := true;
  zIndex := 0;
  for i := 1 to Length(str) do begin
    case str[i] of
      'A'..'Y', 'a'..'y':
        begin
          finishNumber;
          curCmd := str[i]; //Z - особый случай!
        end;
      'z','Z':
        begin
          finishNumber;
          AddBezierIndex(fCount-1); //1я управляющая
          AddBezierIndex(zIndex);  //2я управляющая
          AddBezierIndex(zIndex);  //конец отрезка
        end;
      '0'..'9':
        begin
        //когда прочитываем циферку - никогда не останавливаемся, считаем что она всё продолжается и продолжается!
          if state = psIdle then begin
            curNumber := Byte(str[i]) - Byte('0');
            state := psIntegerPart;
          end
          else if state = psIntegerPart then
            curNumber := curNumber * 10 + Byte(str[i]) - Byte('0')
          else begin
            curNumber := curNumber + (Byte(str[i]) - Byte('0')) / divider;
            divider := divider * 10;
          end;
        end;
      '.':
        begin
          if state = psIdle then
            curNumber := 0 //число из серии .5, т.е целой части вообще нет
          else if state = psDecimalPart then begin
            finishNumber; //уже вторую точку встретили, это значит, новое число началось!
            curNumber := 0;
          end;
          divider := 10;
          state := psDecimalPart;
        end;
      '-':
        begin
          finishNumber; //ежели мы его записывали, то сейчас уже за следующее взялись...
          curSign := -1;
        end;
      ' ', #9,',',#13,#10: finishNumber;
    end;
  end;
  //и под самый конец у нас могут остаться незаконченные дела!
  finishNumber;

  if Length(fBezierPoints) < fBezierPointsSoFar then
    SetLength(fBezierPoints, fBezierPointsSoFar);
end;

Оставить комментарий

Популярные посты:

otho

Нейросети нового поколения: решение задач на основе фото с математическими и текстовыми элементами

varlam_volkov

Мат – национальная трагедия России

berowra_story

Эвкалипт - вдовье дерево.

balmerdx

Пару разрзненных бесполезных фактов.

anti_chief

Европейские политики с низкой социальной ответственностью беспокоятся о судьбе

matsam

Вечернее

vg_saveliev

Евросоюз не распадется, это ошибка

taxfree

Мюнхенский сговор становится реальностью

pantv

16 февраля ● "Именины Кикиморы" и не только...

• Архив