Home Home Archives About red box
Username:
Password:
Filed Under Cross Library
digg Free Pascal Enhancements
visits: 279 | score: 0 
posted by sysrpl on Wednesday October 10, 2012 10:06 AM

an someone anyone help push forward a two features requests I would like implemented for the free pascal compiler? What I want are:

Development environment
1) The ability to overload implicit/explicit conversions of types, with generics support, in class or record helpers.

2) The introduction of "interface helpers" that allow for extension methods to interface types.

To explain why I have these requests, allow me to describe a project I am readying to release.

I'm working on what will soon be an open source project which provides a unified and simplified cross platform high quality 2D vector drawing and animation programming interface, among may other things (sockets, xml handling, encryption, custom controls, and on and on...).

Currently the drawing and animation system is working well. It's powered by different back ends on different platforms. On Windows it uses Direct2D when available with a fallback to GDI+. On Linux when Gnome is available it user uses Cairo (I am also considering a QPainter back end for KDE). On OSX and iOS the API implementation will use Quartz 2D (as soon as I get my hands on Mac hardware to develop and test with).

See video below...



My project includes a fair amount of math related types which take advantage of many newer (and IMO) much needed language features. These features make using the API I provide very easy to use. For example I have a floating point called record type called TRectF. I can center one rect on the top middle of another rect using code like:

// A, B are TRectF, C is ICanvas
begin
  A.Center(B.MidTop);
  C.Rectangle(B);
  C.Fill(clRed);
  C.Rectangle(A);
  C.Fill(clBlue);
end;

ResultThis snippet encapsulates both feature requests. The first is that I currently have written concrete definitions of both TRectF and TRectI record types which mirror each other precisely, the only difference being that TRectF stores its values as Float and TRectI uses Integers.

I'd like to use generics to define some of my primitives, such as rectangles and points, using generics. The problem then comes in implict or explicit conversions from one type to another. Here is some example code showing what I'd like to do with a TPoint<T> type. The problem begins at line 31 with TPointFHelper. The fact that I cannot use generics with my primitives is causing me to duplicate a lot of code and every time I make a change I have to mirror that change in multiple places.

type
  Float = Single;

{ TPoint<T> }

  TPoint<T> = record
  public
    X, Y: T;
    class operator Negative(const A: TPoint<T>): TPoint<T>;
    class operator Equal(const A, B: TPoint<T>): Boolean;
    class operator NotEqual(const A, B: TPoint<T>): Boolean;
    class operator Add(const A, B: TPoint<T>): TPoint<T>;
    class operator Subtract(const A, B: TPoint<T>): TPoint<T>;
    class function Create: TPoint<T>; overload; static;
    class function Create(X, Y: T): TPoint<T>; overload; static;
    function Equals(const Value: TPoint<T>): Boolean;
    function Angle(const P: TPoint<T>): Float;
    function Dist(const P: TPoint<T>): Float;
    function Mid(const P: TPoint<T>): TPoint<T>;
    procedure Offset(X, Y: T); overload;
    procedure Offset(const P: TPoint<T>); overload;
  end;

{ Specialization }

  TPointI = TPoint<Integer>;
  TPointF = TPoint<Float>;
  
{ TPointFHelper }  

  TPointFHelper = record helper for TPointF
    // Compiler error here. Cannot access class types in helpers
    class operator Implicit(const Value: TPointI): TPointF;
    class operator Explicit(const Value: TPointF): TPointI;
  end; 

{ TPointFHelper }

class operator TPointFHelper.Implicit(const Value: TPointI): TPointF;
begin
  Result.X := Value.X;
  Result.Y := Value.Y;
end;

class operator TPointFHelper.Explicit(const Value: TPointF): TPointI;
begin
  Result.X := Round(Value.X);
  Result.Y := Round(Value.Y);
end;
    
{ TPoint<T> }

class operator TPoint<T>.Negative(const A: TPoint<T>): TPoint<T>;
begin
  Result.X := -A.X;
  Result.Y := -A.Y;
end;

class operator TPoint<T>.Equal(const A, B: TPoint<T>): Boolean;
begin
  Result := A.Equals(B);
end;

class operator TPoint<T>.NotEqual(const A, B: TPoint<T>): Boolean;
begin
  Result := not A.Equals(B);
end;

class operator TPoint<T>.Add(const A, B: TPoint<T>): TPoint<T>;
begin
  Result.X := A.X + B.X;
  Result.Y := A.Y + B.Y;
end;

class operator TPoint<T>.Subtract(const A, B: TPoint<T>): TPoint<T>;
begin
  Result.X := A.X - B.X;
  Result.Y := A.Y - B.Y;
end;

class function TPoint<T>.Create: TPoint<T>;
begin
  Result.X := 0;
  Result.Y := 0;
end;

class function TPoint<T>.Create(X, Y: T): TPoint<T>;
begin
  Result.X := X;
  Result.Y := Y;
end;

function TPoint<T>.Equals(const Value: TPoint<T>): Boolean;
begin
  Result := (X = Value.X) and (Y = Value.Y);
end;

...

Then the second request I have is to allow for pretty much the same request as above, except to allow for interface helpers in addition to record helpers. Consider this code:

{ TSolidBrushHelper }  

type
  TSolidBrushHelper = interface helper for ISolidBrush
    class operator Implicit(const Value: TBGRA): ISolidBrush;
    class operator Implicit(Value: ISolidBrush): TBGRA;
  end; 
  
class operator TSolidBrushHelper.Implicit(const Value: TBGRA): ISolidBrush;
begin
  Result := NewSolidBrush(Value);
end;

class operator TSolidBrushHelper.Implicit(Value: ISolidBrush): TBGRA;
begin
  Result := Value.Color;
end;
  
...

begin  
  // which then allows for code like
  C.Fill(clRed);
  // instead of code like this
  C.Fill(NewSolidBrush(clRed));
end;

For your reference here is the interface section of my Canvas unit along with two additional test videos of my project.

unit CrossCanvas;

{ namespace Cross.Drawing }

{$i ../cross.inc}

interface

{ This unit provides an abstract interface to high quality fast vector
  graphics as. On Windows the implementation tries to use Direct2D,
  but falls back to GDI+ if it is not present. On Linux Gtk2+ the
  implementation depends on gdk, cairo, and pango for text 
  rendering.
  
  The abstract interfaces provide the with following features:

  * A simple but powerful drawing interface
  * All resources are managed for you
  * Floating point drawing coordinate system with matrices
  * Pens with a variety of style and stroke options
  * Brushes that can be a solid color, gradient, and an image
  * CopyTo function with destination transform and alpha level support
  * Bitmap interface allowing for fast offscreen in memory rendering
  * Bitmap resampling with three quality levels
  * Easy image saving and loading to most of the popular image formats
  * Very easy to use scalable font rendering
  * A decorative per pixel transparency popup window interface

  Note: Angles used are alway assumed to be in radians }

{ TODO: Provide OSX implemenation using Quartz2D }
{ TODO: Consider providing Qt implemenation using QPainter (is gdk enough?) }

uses
  SysUtils, Classes, Graphics, Controls,
  { Cross library units }
  CrossTypes, CrossGenerics;

{ ICanvas forward types }

type
  TMatrix = TMatrix2x3;
  PMatrix = PMatrix2x3;

  IMatrix = interface;
  IPen = interface;
  IBrush = interface;
  ISolidBrush = interface;
  IGradientBrush = interface;
  IFont = interface;
  IPath = interface;
  ICanvasPath = interface;
  ICanvas = interface;
  IBitmap = interface;

{ IMatrix }

  IMatrix = interface(ICloneable<IMatrix>)
  ['{2918AB0D-E288-4E5C-8FDE-67776EC7CFAD}']
    procedure Identity;
    procedure Multiply(M: IMatrix);
    procedure Rotate(Angle: Float);
    procedure RotateAt(Angle: Float; const P: TPointF);
    procedure Scale(SX, SY: Float);
    procedure ScaleAt(SX, SY: Float; const P: TPointF);
    procedure Translate(X, Y: Float);
    procedure Skew(AngleX, AngleY: Float);
    procedure GetData(out M: TMatrix);
    procedure SetData(const M: TMatrix);
  end;

{ IPen }

  TPenPattern = (pnSolid, pnDash, pnDot, pnDashDot);
  TPenCap = (cpButt, cpRound, cpSquare);
  TPenJoin = (jnMiter, jnRound, jnBevel);

  IPen = interface
  ['{F702E75F-684F-4D02-9A51-682A154DD9D5}']
    function GetBrush: IBrush;
    procedure SetBrush(Value: IBrush);
    function GetColor: TBGRA;
    procedure SetColor(Value: TBGRA);
    function GetWidth: Float;
    procedure SetWidth(Value: Float);
    function GetPattern: TPenPattern;
    procedure SetPattern(Value: TPenPattern);
    function GetOffset: Float;
    procedure SetOffset(Value: Float);
    function GetCap: TPenCap;
    procedure SetCap(Value: TPenCap);
    function GetPenJoin: TPenJoin;
    procedure SetPenJoin(Value: TPenJoin);
    function GetMiterLimit: Float;
    procedure SetMiterLimit(Value: Float);
    property Brush: IBrush read GetBrush write SetBrush;
    property Color: TBGRA read GetColor write SetColor;
    property Width: Float read GetWidth write SetWidth;
    property Pattern: TPenPattern read GetPattern write SetPattern;
    property Offset: Float read GetOffset write SetOffset;
    property Cap: TPenCap read GetCap write SetCap;
    property Join: TPenJoin read GetPenJoin write SetPenJoin;
    property MiterLimit: Float read GetMiterLimit write SetMiterLimit;
  end;

{ IBrush }

  IBrush = interface
  ['{77B25395-F891-4526-A941-77C200C3F08F}']
    function GetMatrix: IMatrix;
    procedure SetMatrix(Value: IMatrix);
    function GetOpacity: Byte;
    procedure SetOpacity(Value: Byte);
    property Matrix: IMatrix read GetMatrix write SetMatrix;
    property Opacity: Byte read GetOpacity write SetOpacity;
  end;

{ ISolidBrush }

  ISolidBrush = interface(IBrush)
  ['{8F520DF0-C9F7-4C5E-8954-9A62179BB84F}']
    function GetColor: TBGRA;
    procedure SetColor(Value: TBGRA);
    property Color: TBGRA read GetColor write SetColor;
  end;

{ IGradientBrush }

  TGradientStop = record
    Color: TBGRA;
    Offset: Float;
  end;

  TGradientStops = TArray<TGradientStop>;

  TGradientWrap = (gwClamp, gwRepeat, gwReflect);

  IGradientBrush = interface(IBrush)
  ['{B3870AD1-4A48-4A0A-AC39-13DD43501E63}']
    function GetWrap: TGradientWrap;
    procedure SetWrap(Value: TGradientWrap);
    procedure AddStop(Color: TBGRA; Offset: Float);
    procedure GetStops(out Stops: TGradientStops);
    procedure SetStops(const Stops: TGradientStops);
    property Wrap: TGradientWrap read GetWrap write SetWrap;
  end;

{ IFont }

  IFont = interface
  ['{9ACA722A-6DDE-4C15-89E0-47DD1B86B981}']
    function GetName: AnsiString;
    function GetColor: TBGRA;
    procedure SetColor(Value: TBGRA);
    function GetStyle: TFontStyles;
    procedure SetStyle(Value: TFontStyles);
    function GetSize: Float;
    procedure SetSize(Value: Float);
    property Name: AnsiString read GetName;
    property Color: TBGRA read GetColor write SetColor;
    property Style: TFontStyles read GetStyle write SetStyle;
    property Size: Float read GetSize write SetSize;
  end;

{ IPath }

  IPath = interface
  ['{C2887F8D-D729-427D-90C2-F9B081697CAB}']
  end;

{ ICanvasPath }

  ICanvasPath = interface(ICloneable<IPath>)
  ['{E2E7EC9A-74BA-4614-8809-7D828E30DD51}']
    procedure Add;
    procedure Remove;
    procedure Close;
    procedure Join(Path: IPath);
    procedure Clip;
    procedure Unclip;
  end;

{ ICanvas is the main interface used to draw high quality fast vector graphics }

  ICanvas = interface
  ['{6C23D3BC-6D74-4EDD-B0B9-EB55BF655E80}']
    function GetFillMode: TFillMode;
    procedure SetFillMode(Value: TFillMode);
    function GetMatrix: IMatrix;
    procedure SetMatrix(Value: IMatrix);
    function GetPath: ICanvasPath;
    procedure Flush;
    procedure Clear(Color: TBGRA);
    procedure CopyTo(const Source: TRectF; Canvas: ICanvas;
      const Dest: TRectF; Alpha: Byte = $FF);
    procedure Save;
    procedure Restore;
    { Normal drawing methods }
    procedure MoveTo(X, Y: Float);
    procedure LineTo(X, Y: Float);
    procedure ArcTo(const Rect: TRectF; BeginAngle, EndAngle: Float);
    procedure CurveTo(X, Y: Float; const C1, C2: TPointF);
    procedure Ellipse(const Rect: TRectF);
    procedure Rectangle(const Rect: TRectF);
    procedure RoundRectangle(const Rect: TRectF; Radius: Float);
    { Text measuring and drawing methods; see comments in CrossTypes
      regarding TDirection and how it effects TextOut }
    function TextSize(Font: IFont; const Text: AnsiString): TPointF;
    function TextHeight(Font: IFont; const Text: AnsiString; Width: Float): Float;
    { TODO: Add ellipses position and accelerator options }
    procedure TextOut(Font: IFont; const Text: AnsiString; const Rect: TRectF;
      Direction: TDirection);
    { Strokes and fills turn drawing methods above into pixels }
    procedure Stroke(Pen: IPen; Preserve: Boolean = False);
    procedure Fill(Brush: IBrush; Preserve: Boolean = False);
    procedure Mask(Mask: IBrush; Brush: IBrush; Preserve: Boolean = False);
    { Friendly methods for drawing pixel aligned rectangles }
    procedure StrokeRect(Pen: IPen; const Rect: TRectF);
    procedure FillRect(Brush: IBrush; const Rect: TRectF);
    procedure StrokeRoundRect(Pen: IPen; const Rect: TRectF; Radius: Float);
    procedure FillRoundRect(Brush: IBrush; const Rect: TRectF; Radius: Float);
    property FillMode: TFillMode read GetFillMode write SetFillMode;
    property Matrix: IMatrix read GetMatrix write SetMatrix;
    property Path: ICanvasPath read GetPath;
  end;

{ IBitmap }

  TImageFormat = (fmPng, fmJpeg, fmGif, fmBmp, fmIco, fmTiff);
  TResampleQuality = (rqLowest, rqNormal, rqBest);

  IBitmap = interface(ICloneable<IBitmap>)
  ['{DB935633-A218-4181-96A2-B0808697150F}']
    function GetEmpty: Boolean;
    function GetCanvas: ICanvas;
    function GetClientRect: TRectI;
    function GetFormat: TImageFormat;
    procedure SetFormat(Value: TImageFormat);
    function GetHeight: Integer;
    function GetWidth: Integer;
    function GetPixels: PPixel;
    procedure Clear;
    function Resample(Width, Height: Integer; Quality: TResampleQuality = rqNormal): IBitmap;
    procedure LoadFromFile(const FileName: AnsiString);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: AnsiString);
    procedure SaveToStream(Stream: TStream);
    procedure SetSize(Width, Height: Integer);
    property Empty: Boolean read GetEmpty;
    property Canvas: ICanvas read GetCanvas;
    property ClientRect: TRectI read GetClientRect;
    property Format: TImageFormat read GetFormat write SetFormat;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property Pixels: PPixel read GetPixels;
  end;

{ ICanvas object creation routines }

function NewMatrix: IMatrix;
function NewPen(Brush: IBrush; Width: Float = 1): IPen; overload;
function NewPen(Color: TBGRA; Width: Float = 1): IPen; overload;
function NewSolidBrush(Color: TBGRA): ISolidBrush; overload;
function NewLinearGradientBrush(X1, Y1, X2, Y2: Float): IGradientBrush; overload;
function NewLinearGradientBrush(const A, B: TPointF): IGradientBrush; overload;
function NewRadialGradientBrush(const Rect: TRectF): IGradientBrush;
function NewBitmapBrush(Bitmap: IBitmap): IBrush;
function NewFont(Font: TFont): IFont;
{ NewCanvas(Canvas) optimized for OnPaint handling }
function NewCanvas(Canvas: TCanvas): ICanvas; overload;
{ NewCanvas(Control) optimized for performance and drawing outside of OnPaint }
function NewCanvas(Control: TWinControl): ICanvas; overload;
function NewBitmap: IBitmap; overload;
function NewBitmap(Width, Height: Integer): IBitmap; overload;
function NewBitmap(const FileName: AnsiString): IBitmap; overload;
function NewBitmap(Stream: TStream): IBitmap; overload;

{ IAlphaControl allows windowed and graphic controls to share the same ICanvas }

type
  IAlphaControl = interface
  ['{269D7255-62A3-4404-86B3-E70CD9ADC017}']
    function GetAlphaCanvasDirect: ICanvas;
    function GetAlphaCanvas: ICanvas;
    function GetAlphaPaint: Boolean;
    procedure SetAlphaPaint(Value: Boolean);
    property AlphaCanvas: ICanvas read GetAlphaCanvas;
    property AlphaPaint: Boolean read GetAlphaPaint write SetAlphaPaint;
  end;

{ IAlphaSplash is a popup window whose size and shape is controlled by IBitmap }

  IAlphaSplash = interface
  ['{5CD65AB4-3CC2-41CA-BF58-BFCA36CE64BC}']
    function GetBitmap: IBitmap;
    function GetOpacity: Byte;
    procedure SetOpacity(Value: Byte);
    function GetVisible: Boolean;
    procedure SetVisible(Value: Boolean);
    procedure Move(X, Y: Integer);
    procedure Update;
    property Bitmap: IBitmap read GetBitmap;
    property Opacity: Byte read GetOpacity write SetOpacity;
    property Visible: Boolean read GetVisible write SetVisible;
  end;

function NewAlphaSplash: IAlphaSplash;

{ Image format routines }

function StrToImageFormat(S: AnsiString): TImageFormat;
function ImageFormatToStr(F: TImageFormat): AnsiString;
function ImageFormatToMimeType(F: TImageFormat): AnsiString;

type
  TCanvasOptions = record
    { Use Direct2D on Windows if avalable }
    HardwareRendering: Boolean;
    { Use double buffering if hardware rendering is not supported }
    SoftwareBuffering: Boolean;
    { Correct small render errors with possible degraded performance or loss of features }
    ErrorCorrection: Boolean;
    { Use gamma corrected gradients on supported back ends }
    GammaCorrection: Boolean;
  end;

var
  CanvasOptions: TCanvasOptions = (
    HardwareRendering: True;
    SoftwareBuffering: True;
    ErrorCorrection: False;
    GammaCorrection: False;
  );

function CanvasHardwareAvailable: Boolean;

const
  PenMiterLimitDefault = 10;

implementation

uses
  CrossCanvasImpl;






print send topic Rate this article  

Title:

image link indent align right align middle align left quote underline bold code quote
Comment:

page generated in 1.358 seconds | last modified 10/09/2012 6:26 PM
none  none