jvqturtle.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTurtle.PAS, released on 2002-06-15.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQTurtle.pas,v 1.16 2004/11/06 22:08:20 asnepvangers Exp $

unit JvQTurtle;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes, QWindows, QMessages, QGraphics, QControls,
  Math;

type
  TRequestBackgroundEvent = procedure(Sender: TObject; Background: string) of object;
  TRequestFilterEvent = procedure(Sender: TObject; Filter: string) of object;
  TRequestImageSizeEvent = procedure(Sender: TObject; var ARect: TRect) of object;

type
  TJvTurtle = class(TComponent)
  private
    FPosition: TPoint;
    FHeading: Real;
    FCanvas: TCanvas;
    FPenDown: Boolean;
    FMark: TPoint;
    FArea: TRect;
    FBackground: string;
    FFilter: string;
    FScript: string;
    FIP: Integer;
    FIPMax: Integer;
    FSP: Integer;
    FNSP: Integer;
    FStack: array of Integer;
    FNStack: array of Integer;
    FVariables: TStringList;
    FAngleMark: Integer;
    FImageRect: TRect;
    FOnRepaintRequest: TNotifyEvent;
    FOnRequestBackground: TRequestBackgroundEvent;
    FOnRequestImageSize: TRequestImageSizeEvent;
    FOnRequestFilter: TRequestFilterEvent;
    function GetToken(var Token: string): Boolean;
    function GetNum(var Num: Integer): Boolean;
    function InVariables(Token: string; var Num: Integer): Boolean;
    function GetTex(var Tex: string): Boolean;
    function GetCol(var Col: TColor): Boolean;
    // function SkipBlock: Boolean;
    function Push(Num: Integer): Boolean;
    function Pop(var Num: Integer): Boolean;
    function NPush(var Msg: string; Num: Integer): Boolean;
    function NPop(var Msg: string; var Num: Integer): Boolean;
    function IsNum(Tex: string): Boolean;
    function IsCol(Tex: string): Boolean;
    function IsVar(Tex: string): Boolean;
    procedure SetPosition(const Value: TPoint);
    procedure SetHeading(const Value: Real);
    procedure SetCanvas(const Value: TCanvas);
    procedure SetPenDown(const Value: Boolean);
    procedure SetPenWidth(const Value: Integer);
    function GetWidth: Integer;
    procedure DoGo(Dest: TPoint);
    function txUser(Sym: string): string;
    function txComment: string;
    function txIn: string;
    function txInAdd: string;
    function txInSub: string;
    function txInMult: string;
    function txInDiv: string;
    function txInInc: string;
    function txInDec: string;
    function txBlock: string;
    function txReturn: string;
    function txPos: string;
    function txDefault: string;
    function txMove: string;
    function txLineTo: string;
    function txAngle: string;
    function txDown: string;
    function txUp: string;
    function txPenSize: string;
    function txPenColor: string;
    function txAddPenColor: string;
    function txAddBrushColor: string;
    function txTurn: string;
    function txLeft: string;
    function txRight: string;
    function txGo: string;
    function txText: string;
    function txTextOut: string;
    function txTextFont: string;
    function txTextSize: string;
    function txTextColor: string;
    function txTextBold: string;
    function txTextItalic: string;
    function txTextUnderline: string;
    function txTextNormal: string;
    function txBsSolid: string;
    function txBsClear: string;
    function txBrushColor: string;
    function txRectangle: string;
    function txRoundRect: string;
    function txEllipse: string;
    function txDiamond: string;
    function txPolygon: string;
    function txStar: string;
    function txCurve: string;
    function txMark: string;
    function txGoMark: string;
    function txMarkAngle: string;
    function txGoMarkAngle: string;
    function txArea: string;
    function txCopy: string;
    function txPenMode: string;
    function txCopyMode: string; 
    function txDo: string;
    function txLoop: string;
    function txGoLeft: string;
    function txGoTop: string;
    function txGoRight: string;
    function txGoBottom: string;
    function txGoCenter: string;
    function txAdd: string;
    function txSub: string;
    function txMul: string;
    function txDiv: string;
    function txDup: string;
    function txDrop: string;
    function tx_PosX: string;
    function tx_PosY: string;
    function tx_PenColor: string;
    function tx_BrushColor: string;
    function tx_TextColor: string;
    function tx_PenSize: string;
    function tx_TextSize: string;
    function tx_Angle: string;
    function tx_MarkX: string;
    function tx_MarkY: string;
    function tx_Loop: string;
    function tx_Right: string;
    function tx_Left: string;
    function tx_Top: string;
    function tx_Bottom: string;
    function txIf: string;
    function txGt: string;
    function txGe: string;
    function txLt: string;
    function txLe: string;
    function txEq: string;
    function txNe: string;
    function txNot: string;
    function txAnd: string;
    function txOr: string;
    function txNeg: string;
    function txAbs: string;
    function txSwap: string;
    function txMax: string;
    function txMin: string;
    function txSqr: string;
    function txSqrt: string;
    function txInc: string;
    function txDec: string;
    function txBackground: string;
    function txFilter: string;
    function StrToPenMode(var Pm: TPenMode; S: string): Boolean;
    function StrToCopyMode(var Cm: TCopyMode; S: string): Boolean;
    procedure TextRotate(X, Y, Angle: Integer; AText: string; AFont: TFont);
    procedure SetOnRepaintRequest(const Value: TNotifyEvent);
    procedure SetMark(const Value: TPoint);
    procedure SetArea(const Value: TRect);
    procedure SetOnRequestBackground(const Value: TRequestBackgroundEvent);
    procedure SetOnRequestImageSize(const Value: TRequestImageSizeEvent);
    procedure SetOnRequestFilter(const Value: TRequestFilterEvent);
  protected
    procedure DoRepaintRequest; virtual;
    procedure DoRequestBackground; virtual;
    procedure DoRequestFilter; virtual;
    function DoRequestImageSize: Boolean; virtual;
  public
    property Canvas: TCanvas read FCanvas write SetCanvas;
    property Position: TPoint read FPosition write SetPosition;
    property Mark: TPoint read FMark write SetMark;
    property Area: TRect read FArea write SetArea;
    property Heading: Real read FHeading write SetHeading;
    property PenDown: Boolean read FPenDown write SetPenDown;
    property PenWidth: Integer read GetWidth write SetPenWidth;
    function DoCom: string;
    procedure Turn(AAngle: Real);
    procedure Right(AAngle: Real);
    procedure MoveForward(ADistance: Real);
    procedure MoveBackward(ADistance: Real);
    function Interpret(var ALine, ACol: Integer; const S: TStrings): string;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnRepaintRequest: TNotifyEvent read FOnRepaintRequest write SetOnRepaintRequest;
    property OnRequestBackground: TRequestBackgroundEvent read FOnRequestBackground write SetOnRequestBackground;
    property OnRequestFilter: TRequestFilterEvent read FOnRequestFilter write SetOnRequestFilter;
    property OnRequestImageSize: TRequestImageSizeEvent read FOnRequestImageSize write SetOnRequestImageSize;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQConsts, JvQTypes, JvQResources;

constructor TJvTurtle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FVariables := TStringList.Create;
  FVariables.Sorted := True;
  SetLength(FStack, 256);
  SetLength(FNStack, 256);
  txDefault;
end;

destructor TJvTurtle.Destroy;
begin
  FVariables.Free;
  inherited Destroy;
end;

function TJvTurtle.DoCom: string;
const
  // sorted for binary search
  Mapper: array [0..101] of PChar =
   (
    '-',
    '*',
    '.and',
    '.eq',
    '.ge',
    '.gt',
    '.le',
    '.lt',
    '.ne',
    '.not',
    '.or',
    '/',
    '[',
    ']',
    '{',
    '+',
    '=angle',
    '=bottom',
    '=brushcolor',
    '=left',
    '=loop',
    '=markx',
    '=marky',
    '=pencolor',
    '=pensize',
    '=posx',
    '=posy',
    '=right',
    '=textcolor',
    '=textsize',
    '=top',
    'abs',
    'addbrushcolor',
    'addpencolor',
    'angle',
    'area',
    'background',
    'bold',
    'brushcolor',
    'bsclear',
    'bssolid',
    'copy',
    'copymode',
    'curve',
    'dec',
    'default',
    'diamond',
    'do',
    'down',
    'drop',
    'dup',
    'ellipse',
    'filter',
    'flood',
    'go',
    'gobottom',
    'gocenter',
    'goleft',
    'gomark',
    'gomarkangle',
    'goright',
    'gotop',
    'if',
    'in',
    'inadd',
    'inc',
    'indec',
    'indiv',
    'ininc',
    'inmul',
    'insub',
    'italic',
    'left',
    'lineto',
    'loop',
    'mark',
    'markangle',
    'max',
    'min',
    'move',
    'neg',
    'normal',
    'pencolor',
    'penmode',
    'pensize',
    'polygon',
    'pos',
    'rectangle',
    'right',
    'roundrect',
    'sqr',
    'sqrt',
    'star',
    'swap',
    'text',
    'textcolor',
    'textfont',
    'textout',
    'textsize',
    'turn',
    'underline',
    'up'
   );
var
  Com: string;
  Lo, Mid, Hi: Integer;
begin
  Result := 'ready';
  if not GetToken(Com) then
    Exit;

  Lo := Low(Mapper);
  Hi := High(Mapper)+1;
  repeat
    Mid := Lo + (Hi - Lo) div 2;
    if Com > Mapper[Mid] then
      Lo := Mid+1
    else
      Hi := Mid;
  until Lo >= Hi;
  if (Hi > High(Mapper)) or (Com <> Mapper[Hi]) then
    Hi := -1;

  case Hi of
    0:
      Result := txSub;
    1:
      Result := txMul;
    2:
      Result := txAnd;
    3:
      Result := txEq;
    4:
      Result := txGe;
    5:
      Result := txGt;
    6:
      Result := txLe;
    7:
      Result := txLt;
    8:
      Result := txNe;
    9:
      Result := txNot;
    10:
      Result := txOr;
    11:
      Result := txDiv;
    12:
      Result := txBlock;
    13:
      Result := txReturn;
    14:
      Result := txComment;
    15:
      Result := txAdd;
    16:
      Result := tx_Angle;
    17:
      Result := tx_Bottom;
    18:
      Result := tx_BrushColor;
    19:
      Result := tx_Left;
    20:
      Result := tx_Loop;
    21:
      Result := tx_MarkX;
    22:
      Result := tx_MarkY;
    23:
      Result := tx_PenColor;
    24:
      Result := tx_PenSize;
    25:
      Result := tx_PosX;
    26:
      Result := tx_PosY;
    27:
      Result := tx_Right;
    28:
      Result := tx_TextColor;
    29:
      Result := tx_TextSize;
    30:
      Result := tx_Top;
    31:
      Result := txAbs;
    32:
      Result := txAddBrushColor;
    33:
      Result := txAddPenColor;
    34:
      Result := txAngle;
    35:
      Result := txArea;
    36:
      Result := txBackground;
    37:
      Result := txTextBold;
    38:
      Result := txBrushColor;
    39:
      Result := txBsClear;
    40:
      Result := txBsSolid;
    41:
      Result := txCopy;
    42:
      Result := txCopyMode;
    43:
      Result := txCurve;
    44:
      Result := txDec;
    45:
      Result := txDefault;
    46:
      Result := txDiamond;
    47:
      Result := txDo;
    48:
      Result := txDown;
    49:
      Result := txDrop;
    50:
      Result := txDup;
    51:
      Result := txEllipse;
    52:
      Result := txFilter;   
    54:
      Result := txGo;
    55:
      Result := txGoBottom;
    56:
      Result := txGoCenter;
    57:
      Result := txGoLeft;
    58:
      Result := txGoMark;
    59:
      Result := txGoMarkAngle;
    60:
      Result := txGoRight;
    61:
      Result := txGoTop;
    62:
      Result := txIf;
    63:
      Result := txIn;
    64:
      Result := txInAdd;
    65:
      Result := txInc;
    66:
      Result := txInDec;
    67:
      Result := txInDiv;
    68:
      Result := txInInc;
    69:
      Result := txInMult;
    70:
      Result := txInSub;
    71:
      Result := txTextItalic;
    72:
      Result := txLeft;
    73:
      Result := txLineTo;
    74:
      Result := txLoop;
    75:
      Result := txMark;
    76:
      Result := txMarkAngle;
    77:
      Result := txMax;
    78:
      Result := txMin;
    79:
      Result := txMove;
    80:
      Result := txNeg;
    81:
      Result := txTextNormal;
    82:
      Result := txPenColor;
    83:
      Result := txPenMode;
    84:
      Result := txPenSize;
    85:
      Result := txPolygon;
    86:
      Result := txPos;
    87:
      Result := txRectangle;
    88:
      Result := txRight;
    89:
      Result := txRoundRect;
    90:
      Result := txSqr;
    91:
      Result := txSqrt;
    92:
      Result := txStar;
    93:
      Result := txSwap;
    94:
      Result := txText;