jvturtle.pas

East make Tray Icon in delphi

function TJvTurtle.txUser(Sym: string): string;
var
  P: Integer;
begin
  P := Pos(Sym, FScript);
  if P <> 0 then
  begin
    if Push(FIP) then
    begin
      FIP := P + Length(Sym);
      Result := '';
    end
    else
      Result := RsStackOverflow;
  end
  else
    Result := Format(RsSymbolsIsNotDefined, [Sym]);
end;

function TJvTurtle.txBlock: string;
begin
  while (FIP <= FIPMax) and (FScript[FIP] <> ']') do
    Inc(FIP);
  if FIP <= FIPMax then
  begin
    Inc(FIP);
    Result := '';
  end
  else
    Result := RsMissingAfterBlock;
end;

function TJvTurtle.txReturn: string;
var
  Num: Integer;
begin
  if Pop(Num) then
  begin
    FIP := Num;
    Result := '';
  end
  else
    Result := RsStackUnderflow;
end;

function TJvTurtle.tx_Angle: string;
var
  Num: Integer;
begin
  Num := Variant(Heading);
  NPush(Result, Num);
end;

function TJvTurtle.tx_Bottom: string;
begin
  if DoRequestImageSize then
    NPush(Result, FImageRect.Bottom)
  else
    Result := Format(RsErrorIns, ['=bottom']);
end;

function TJvTurtle.tx_BrushColor: string;
begin
  NPush(Result, Canvas.Brush.Color);
end;

function TJvTurtle.tx_Left: string;
begin
  if DoRequestImageSize then
    NPush(Result, FImageRect.Left)
  else
    Result := Format(RsErrorIns, ['=left']);
end;

function TJvTurtle.tx_Loop: string;
var
  Num: Integer;
begin
  if Pop(Num) then
  begin
    Push(Num);
    NPush(Result, Num);
  end
  else
    Result := Format(RsStackUnderflowIns, ['=loop']);
end;

function TJvTurtle.tx_MarkX: string;
begin
  NPush(Result, Mark.X);
end;

function TJvTurtle.tx_MarkY: string;
begin
  NPush(Result, Mark.Y);
end;

function TJvTurtle.tx_PenColor: string;
begin
  NPush(Result, Canvas.Pen.Color);
end;

function TJvTurtle.tx_PosX: string;
begin
  NPush(Result, Position.X);
end;

function TJvTurtle.tx_PosY: string;
begin
  NPush(Result, Position.Y);
end;

function TJvTurtle.tx_Right: string;
begin
  if DoRequestImageSize then
    NPush(Result, FImageRect.Right)
  else
    Result := Format(RsErrorIns, ['=right']);
end;

function TJvTurtle.tx_Top: string;
begin
  if DoRequestImageSize then
    NPush(Result, FImageRect.Top)
  else
    Result := Format(RsErrorIns, ['=top']);
end;

function TJvTurtle.tx_PenSize: string;
begin
  NPush(Result, Canvas.Pen.Width);
end;

function TJvTurtle.tx_TextColor: string;
begin
  NPush(Result, Canvas.Font.Color);
end;

function TJvTurtle.tx_TextSize: string;
begin
  NPush(Result, Canvas.Font.Size);
end;

function TJvTurtle.txIf: string;
var
  Num: Integer;
  Token: string;
begin
  if NPop(Result, Num) then
    if Num = 0 then
      if GetToken(Token) then
        Result := ''
      else
        Result := RsSymbolExpectedAfterIf;
end;

function TJvTurtle.txAnd: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord((A <> 0) and (B <> 0)));
end;

function TJvTurtle.txEq: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord(A = B));
end;

function TJvTurtle.txGe: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord(A >= B));
end;

function TJvTurtle.txGt: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord(A > B));
end;

function TJvTurtle.txLe: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord(A <= B));
end;

function TJvTurtle.txLt: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord(A < B));
end;

function TJvTurtle.txNe: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord(A <> B));
end;

function TJvTurtle.txNot: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    NPush(Result, Ord(A = 0))
end;

function TJvTurtle.txOr: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Ord((A <> 0) or (B <> 0)));
end;

function TJvTurtle.txAbs: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    NPush(Result, Abs(A))
end;

function TJvTurtle.txNeg: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    NPush(Result, -A);
end;

function TJvTurtle.txSwap: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
  begin
    NPush(Result, B);
    NPush(Result, A);
  end;
end;

function TJvTurtle.txMax: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Max(A, B));
end;

function TJvTurtle.txMin: string;
var
  A, B: Integer;
begin
  if NPop(Result, B) and NPop(Result, A) then
    NPush(Result, Min(A, B));
end;

function TJvTurtle.txSqr: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    NPush(Result, Variant(Sqr(A)));
end;

function TJvTurtle.txSqrt: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    if A <> 0 then
      NPush(Result, Variant(Sqrt(A)))
    else
      Result := RsCanNotTakeSqrtOf;
end;

function TJvTurtle.txDec: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    NPush(Result, A-1);
end;

function TJvTurtle.txInc: string;
var
  A: Integer;
begin
  if NPop(Result, A) then
    NPush(Result, A+1);
end;

function TJvTurtle.txPolygon: string;
var
  I, S, N: Integer;
  OldDown: Boolean;
  OldHeading, A: Real;
  Pt: TPoint;
begin
  Result := Format(RsInvalidIntegerIns, ['polygon']);
  if not (GetNum(N) and GetNum(S)) then
    Exit;
  Result := Format(RsNotAllowedIns, ['polygon']);
  if (N = 0) or (S = 0) then
    Exit;
  Result := Format(RsNeedMinimumOfSidesIns, ['polygon']);
  if N < 3 then
    Exit;
  OldHeading := Heading;
  Pt := Position;
  OldDown := PenDown;
  PenDown := True;
  A := 360 / N;
  for I := 1 to N - 1 do
  begin
    MoveForward(S);
    Turn(A);
  end;
  Canvas.LineTo(Pt.X, Pt.Y);
  PenDown := OldDown;
  Heading := OldHeading;
  Position := Pt;
  Result := '';
end;

function TJvTurtle.txStar: string;
var
  I, S, N: Integer;
  OldDown: Boolean;
  A, OldHeading: Real;
  Pt: TPoint;
begin
  Result := Format(RsInvalidIntegerIns, ['star']);
  if not (GetNum(N) and GetNum(S)) then
    Exit;
  Result := Format(RsNotAllowedIns, ['star']);
  if (N = 0) or (S = 0) then
    Exit;
  Result := Format(RsNeedMinimumOfSidesIns, ['star']);
  if N < 3 then
    Exit;
  Result := Format(RsMaximumSidesExceededIns, ['star']);
  if N > 12 then
    Exit;
  OldHeading := Heading;
  Pt := Position;
  OldDown := PenDown;
  PenDown := True;
  A := (N div 2) * 360 / N;
  for I := 1 to N - 1 do
  begin
    MoveForward(S);
    Turn(A);
  end;
  Canvas.LineTo(Pt.X, Pt.Y);
  PenDown := OldDown;
  Heading := OldHeading;
  Position := Pt;
  Result := '';
end;

function TJvTurtle.txLineTo: string;
var
  X, Y: Integer;
begin
  if GetNum(X) and GetNum(Y) then
  begin
    Canvas.MoveTo(Position.X, Position.Y);
    Canvas.LineTo(Position.X + X, Position.Y + Y);
    Position := Point(Position.X + X, Position.Y + Y);
    Result := '';
  end
  else
    Result := Format(RsInvalidIntegerIns, ['lineto']);
end;

function TJvTurtle.txRoundRect: string;
var
  X2, Y2, RX, RY: Integer;
begin
  if GetNum(X2) and GetNum(Y2) and GetNum(RX) and GetNum(RY) then
  begin
    X2 := Position.X + X2;
    Y2 := Position.Y + Y2;
    Canvas.RoundRect(Position.X, Position.Y, X2, Y2, RX, RY);
    Result := '';
  end
  else
    Result := Format(RsInvalidIntegerIns, ['roundrect']);
end;

function TJvTurtle.txDefault: string;
begin
  Result := '';
  Heading := 0;
  Position := Point(0, 0);
  PenDown := False;
  if Assigned(Canvas) then
  begin
    Canvas.Pen.Color := clWindowText;  // (rom) from clBlack
    Canvas.Brush.Color := clWindow;    // (rom) from clWhite
    Canvas.Font.Color := clWindowText; // (rom) added
    Canvas.CopyMode := cmSrcCopy;
  end;
  Mark := Position;
  Area := Rect(0, 0, 0, 0);
end;

function TJvTurtle.txIn: string;
var
  Token: string;
  Num: Integer;
  N: Integer;
begin
  if NPop(Result, Num) then
    if GetToken(Token) then
    begin
      if not FVariables.Find(Token, N) then
        N := FVariables.Add(Token);
      FVariables.Objects[N] := TObject(Num);
      Result := '';
    end
    else
      Result := RsTokenExpected;
end;

function TJvTurtle.IsVar(Tex: string): Boolean;
var
  N: Integer;
  Msg: string;
begin
  Result := FVariables.Find(Tex, N);
  if Result then
    Result := NPush(Msg, Integer(FVariables.Objects[N]));
end;

function TJvTurtle.txInAdd: string;
var
  Token: string;
  N, Num: Integer;
begin
  if NPop(Result, Num) then
    if GetToken(Token) then
    begin
      if FVariables.Find(Token, N) then
      begin
        FVariables.Objects[N] := TObject(Integer(FVariables.Objects[N]) + Num);
        Result := '';
      end
      else
        Result := Format(RssDoesNotExist, [Token]);
    end
    else
      Result := RsTokenExpected;
end;

function TJvTurtle.txInSub: string;
var
  Token: string;
  N, Num: Integer;
begin
  if NPop(Result, Num) then
    if GetToken(Token) then
    begin
      if FVariables.Find(Token, N) then
      begin
        FVariables.Objects[N] := TObject(Integer(FVariables.Objects[N]) - Num);
        Result := '';
      end
      else
        Result := Format(RssDoesNotExist, [Token]);
    end
    else
      Result := RsTokenExpected;
end;

function TJvTurtle.txInMult: string;
var
  Token: string;
  N, Num: Integer;
begin
  if NPop(Result, Num) then
    if GetToken(Token) then
    begin
      if FVariables.Find(Token, N) then
      begin
        FVariables.Objects[N] := TObject(Integer(FVariables.Objects[N]) * Num);
        Result := '';
      end
      else
        Result := Format(RssDoesNotExist, [Token]);
    end
    else
      Result := RsTokenExpected;
end;

function TJvTurtle.txInDiv: string;
var
  Token: string;
  N, Num: Integer;
begin
  if NPop(Result, Num) then
    if Num = 0 then
      Result := RsDivisionByZeroNotAllowedInIn
    else
    if GetToken(Token) then
    begin
      if FVariables.Find(Token, N) then
      begin
        FVariables.Objects[N] := TObject(Integer(FVariables.Objects[N]) div Num);
        Result := '';
      end
      else
        Result := Format(RssDoesNotExist, [Token]);
    end
    else
      Result := RsTokenExpected;
end;

function TJvTurtle.txInDec: string;
var
  Token: string;
  N: Integer;
begin
  if GetToken(Token) then
  begin
    if FVariables.Find(Token, N) then
    begin
      FVariables.Objects[N] := TObject(Integer(FVariables.Objects[N]) - 1);
      Result := '';
    end
    else
      Result := Format(RssDoesNotExist, [Token]);
  end
  else
    Result := RsTokenExpected;
end;

function TJvTurtle.txInInc: string;
var
  Token: string;
  N: Integer;
begin
  if GetToken(Token) then
  begin
    if FVariables.Find(Token, N) then
    begin
      FVariables.Objects[N] := TObject(Integer(FVariables.Objects[N]) + 1);
      Result := '';
    end
    else
      Result := Format(RssDoesNotExist, [Token]);
  end
  else
    Result := RsTokenExpected;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.