Archive
Smart Pascal: A real life desktop
Every now and then I get feedback like “can SMS use jQuery?” or “Why don’t you use Sencha’s widgets“. And it just continues with everyone having their own favorite framework that they want SMS to adopt.
First of all, this is to completely misunderstand the architecture of Smart. You can use any framework you like. But you also have to sit down and write some code to incorporate it into the VJL. And believe me it’s not that hard.
The workbench
One of the cooler demo’s that I have been working on for .. oh, 8 hours now, is more or less a full Amiga OS 4 desktop clone. Sounds useless right? Well not really. It demonstrates some fundamental concepts:
- How to create windows just like eh, windows have
- How to display file-items in a listview
- How to create controls outside the form so they remain unaffected by form switching
- How to host demos and pre-compiled applications inside forms
But why stop there? Why not setup a node.js server and have the desktop act as a front-end to your server?
NAS front end
If you go out and buy a NAS today, chances are it comes with an HTML interface. So once you plug it into your router, you can browse to it and control the device via the browser.
Ring a bell? That is exactly what I’m doing right here. And it took me less than one working day to get this up and running. Here is how it looks right now:

Running a full remake of a classic demo in a window. No problem. You can run as much code as memory can hold
But I want widget set x, y, z!
Had I done you the disservice of using Sencha or jQueryUI or whatever widget framework, you would have been stuck with that forever. Instead, you get a VCL like framework that is build in a way that ensures – that it can absorb and integrate any UI.
But let’s get back to that desktop.
You probably think: Ok so you have a fake desktop in a browser, it can run some JS demos and look cool. But so what?
You don’t get it. Did you know that X, the display system on Linux is by client / server system by default? Did you know that the entire Linux desktop is just an X client that connects to the server (the server being in the same distro) in order to do it’s business? If you start looking at what you can do – as opposed to what you imagine is impossible, there is a lot of cool stuff you can do for your company right now.

Doing some GPU profiling and watching the callstack
The first thing you need is to set up a server. A node.js server of course, that the website can talk to. Heck you can even do OAuth2 calls to dropbox and whatever online service you like – and get that on your HTML5 desktop without node.
Node however allows you to get system-level access. Listing files, loading files, saving files and even loading programs. Programs here being compiles Smart applications that the desktop can inject and execute inside a “window”.
Whenever you need something executing on the server – well then you call the server via websocket.
If node.js doesn’t do it for you then write it in Delphi or C++, it doesnt really matter. What matters is that you have a universal access point in the browser.
A quick visit to npm and git and you can download fully functional text-processors and large-scale HTML5 applications that does exactly what OpenOffice does. And with that websocket connection to your back-end, you have a real-life solution on your hands.
Here is a quick and dirty storage device API I made. Ram-disk will just store data to a B-Tree based “fake” in-memory filesystem. The real deal will come via websocket on the server.
unit Wb.desktop.Devices; interface uses System.Types, System.Types.Convert, System.Streams, System.Reader, System.Writer, System.Stream.Reader, System.Stream.Writer, System.Time, SmartCL.System, SmartCL.Time; type TWbStorageDevice = class; TWbStorageDeviceRamDisk = class; TWbDeviceManager = class; TWbCustomFileSystem = class; TWbVirtualFileSystem = class; TWbRemoteFileSystem = class; TWbLocalFileSystem = class; TWbStorageDeviceClass = class of TWbStorageDevice; TWbCustomFileSystem = class(TObject) end; TWbVirtualFileSystem = class(TWbCustomFileSystem) end; TWbRemoteFileSystem = class(TWbCustomFileSystem) end; TWbLocalFileSystem = class(TWbCustomFileSystem) end; /* Requirements for using a device */ TWbStorageDeviceOptions = set of ( doRequireLogin, // Require authentication before Mount() doReadOnly // Device is read-only ); /* Filesystem access rights */ TWbStorageDeviceAccess = set of ( daNone, // none daReadOnly, // read files only daReadWrite, // read and write [create] daExecute // can execute ); TWbAuthenticatedEvent = procedure (Sender: TWbStorageDevice; Access: TWbStorageDeviceAccess); TWbMountEvent = procedure (Sender: TWbStorageDevice); /* Abstract storage device */ TWbStorageDevice = class(TObject) private FId: string; FName: string; FFileSystem: TWbCustomFileSystem; FOptions: TWbStorageDeviceOptions; FMounted: boolean; FAuthenticated: boolean; FManager: TWbDeviceManager; protected procedure SetName(const NewName: string); virtual; procedure SetIdentifier(const NewId: string); virtual; procedure SetFileSystem(const NewFileSystem: TWbCustomFileSystem); virtual; function GetFileSystem: TWbCustomFileSystem; virtual; procedure SetOptions(const NewOptions: TWbStorageDeviceOptions); virtual; function GetOptions: TWbStorageDeviceOptions; virtual; procedure SetAuthenticated(const NewState: boolean); virtual; public property Name: string read FName; property Identifier: string read FId; property FileSystem: TWbCustomFileSystem read GetFileSystem; property Options: TWbStorageDeviceOptions read GetOptions; property Mounted: boolean read FMounted; property Authenticated: boolean read FAuthenticated; property DeviceManager: TWbDeviceManager read FManager; procedure Authenticate(UserName, Password: string; const Success: TWbAuthenticatedEvent); overload; procedure Authenticate(UserName, Password, Domain: string; Success: TWbAuthenticatedEvent); overload; procedure Authenticate(AuthKey: string; Success: TWbAuthenticatedEvent); overload; procedure Mount(const Success: TWbMountEvent); procedure UnMount; constructor Create(const Manager: TWbDeviceManager); virtual; destructor Destroy; override; end; /* RAM DISK */ TWbStorageDeviceRamDisk = class(TWbStorageDevice) protected function GetFileSystem: TWbCustomFileSystem; override; public constructor Create(const Manager: TWbDeviceManager); override; end; /* Cache disk */ TWbStorageDeviceCache = class(TWbStorageDevice) protected function GetFileSystem: TWbCustomFileSystem; override; public constructor Create(const Manager: TWbDeviceManager); override; end; TWbDeviceManager = class(TObject) private FClasses: array of TWbStorageDeviceClass; FObjects: array of TWbStorageDevice; public procedure RegisterDevice(const DeviceClass: TWbStorageDeviceClass); property Count: integer read ( FObjects.Count ); property Device[const Index: integer]: TWbStorageDevice read ( FObjects[Index] ); default; destructor Destroy; override; end; implementation //############################################################################# // TWbDeviceManager //############################################################################# destructor TWbDeviceManager.Destroy; begin while FObjects.Count >0 do begin FObjects[0].free; FObjects.Delete(0,1); end; FClasses.Clear(); inherited; end; procedure TWbDeviceManager.RegisterDevice(const DeviceClass: TWbStorageDeviceClass); begin if FClasses.IndexOf(DeviceClass) < 0 then begin FClasses.add(DeviceClass); FObjects.add( DeviceClass.Create(self) ); end; end; //############################################################################# // TWbStorageDeviceCache //############################################################################# constructor TWbStorageDeviceCache.Create(const Manager: TWbDeviceManager); begin inherited Create(Manager); SetName('DH0'); SetIdentifier('{2D58F4D9-D8FE-434C-AC32-8B27EEC0AEE2}'); SetOptions([doReadOnly]); end; function TWbStorageDeviceCache.GetFileSystem: TWbCustomFileSystem; begin result := inherited GetFileSystem(); if result = nil then begin result := TWbVirtualFileSystem.Create; SetFileSystem(result); end; end; //############################################################################# // TWbRamDisk //############################################################################# constructor TWbStorageDeviceRamDisk.Create(const Manager: TWbDeviceManager); begin inherited Create(Manager); SetName('Ram-Disk'); SetIdentifier('{2E6D58D0-A0C3-4D62-8AC4-0300619418A6}'); SetOptions([]); end; function TWbStorageDeviceRamDisk.GetFileSystem: TWbCustomFileSystem; begin result := inherited GetFileSystem(); if result = nil then begin result := TWbVirtualFileSystem.Create; SetFileSystem(result); end; end; //############################################################################# // TWbStorageDevice //############################################################################# constructor TWbStorageDevice.Create(const Manager: TWbDeviceManager); begin inherited Create; FManager := Manager; end; destructor TWbStorageDevice.Destroy; begin if FFileSystem <> nil then FFileSystem.free; inherited; end; procedure TWbStorageDevice.Mount(const Success: TWbMountEvent); begin if FMounted then UnMount; FMounted := true; if assigned(Success) then begin TW3Dispatch.Execute( procedure () begin Success(self); end, 100); end; end; procedure TWbStorageDevice.UnMount; begin if FMounted then begin FMounted := false; end; end; procedure TWbStorageDevice.SetAuthenticated(const NewState: boolean); begin FAuthenticated := NewState; end; procedure TWbStorageDevice.SetOptions(const NewOptions: TWbStorageDeviceOptions); begin FOptions := NewOptions; end; function TWbStorageDevice.GetOptions: TWbStorageDeviceOptions; begin result := FOptions; end; procedure TWbStorageDevice.SetName(const NewName: string); begin FName := NewName; end; procedure TWbStorageDevice.SetIdentifier(const NewId: string); begin FId := NewId; end; procedure TWbStorageDevice.SetFileSystem(const NewFileSystem: TWbCustomFileSystem); begin FFileSystem := NewFileSystem; end; function TWbStorageDevice.GetFileSystem: TWbCustomFileSystem; begin result := FFileSystem; end; procedure TWbStorageDevice.Authenticate(UserName, Password: string; const Success: TWbAuthenticatedEvent); begin end; procedure TWbStorageDevice.Authenticate(UserName, Password, Domain: string; Success: TWbAuthenticatedEvent); begin end; procedure TWbStorageDevice.Authenticate(AuthKey: string; Success: TWbAuthenticatedEvent); begin end; end.
So. Writing the foundation of a NAS front-end in Smart, a virtual desktop with a windowing toolkit took me less than 8 hours. How long would it take you in vanilla JS?
So forgive me if I dont take jQuery serious.
20% discount on HexLicense!
For a short time Quartex Components offer you the FMX, VCL and VJL package with a whopping $40 discount! That is a significant saving for a great product!
By acting now you gain full access to the classical component packages – as well as the next-generation licensing engine and platform:

Ironwood now supports Smart Pascal! The Delphi update is just around the corner. Start using Hexlicense in Delphi today!
- 12 month subscription
- 4 updates guaranteed
- Full source code
- VCL version
- FMX version
- Windows
- OS X
- iOS
- Android
- JVL version (Smart)
- All mobile platforms
- HTML5 applications
- Node.js client and server applications
- Solid documentation
- Easy to use and drop into existing projects
- Ships with examples
- Support via E-mail
Ironwood
The next generation HexLicense formula and license generator is nicknamed “Ironwood”. This has been in the making for some time and is through the beta phase. It uses the absolute latest RTL for Smart – which will be in circulation within a 1 to 2 weeks (hopefully sooner!). So you are getting the absolute latest to play with – which is can be used by both visual and node.js projects.
By acting now you not only save money but you also get a great deal on our classical Delphi components. Most importantly however, is that the discount buys you access to the next generation components for Delphi as well. These will retail at a higher price when they hit the market.
Smart Pascal
With mobile application development taking place more and more through HTML5 and phonegap – not to mention that node.js is quickly becoming a market standard server-side, compilers that targets the JavaScript virtual machine is becoming increasingly important. Especially for traditional languages like Delphi and C++.
With access to Ironwood for Delphi and Smart Pascal, your existing VCL and FMX products can continue to function as they do right now – while you move your licensing mechanisms to the cost-effective, scalable and portable node.js platform.
Why pay huge amounts of money to rent a full virtual instance to host a native Delphi service – when you can do the exact same under node.js for but a fraction of the price? Not to mention the many benefits node brings to the table.
Discount covers all platforms!
The offer gives you the entire system, including VCL, FMX and JVL editions. You also secure access to Ironwood for Delphi.
Again, this package will retail at a higher price and forms the basis of our future cloud based licensing services.
Hexlicense for Delphi can be dropped directly into existing projects, comes with a license generator application and is considered very easy to use.
By acting now you secure early access!
Note: This is a time limited offer. Only the link above this text is valid for this discount.
To read more about HexLicense, head over to the website. You can also download the documentation which is substancial and covers everything.
Smart Pascal: Cool tricks for better code
What is the most costly operation for a HTML5 application? While there are many to pick from the most time-consuming tasks are without a doubt sizing elements and creating elements.
Both of these operations are time-consuming (in cpu terms) because they have a direct impact on the entire layout. In other words, when you create a visible element (which happens when a Smart visual control is created), the entire DOM is affected. The same naturally happens when you adjust the size of an element, because the browser will go through all it’s nodes and re-build its calculated stylesheet (which is a hidden stylesheet that the browser amalgams together).
Since this is the case it makes sense to try to avoid sizing controls as much as possible. You can’t completely avoid it of course – but the less change to width and height the better.
Use the percentages
The Smart Pascal RTL follows the traditional, Delphi and LCL esquire component model. This means that the position and width or height of a control is measured in pixels. But HTML, as you no doubt are aware of, can also work in percentages. This is a lot faster since the browser completely takes care of sizing.
A neat trick you can use is to alter the size of a child control using percentages – and this way avoid any manual calls to Resize(). It all depends on the situation of course, but if (for example) you have a child control that should always be the total width of its parent – you can in fact directly set the width to 100%.
Since the width and height properties are managed by the RTL you want to avoid altering those. They expect values to be in pixels, so changing these values can result in unexpected side-effects. But you can modify the minimum and maximum size styles without affecting the RTL.
w3_setStyle(FContent.Handle, 'min-width', '100%'); w3_setStyle(FContent.Handle, 'min-height', '100%');
The above code takes a child control (“FContent” in this example) and forces it to cover 100% of the parent’s surface. This will work as long as the actual width property does not exceed 100%. If your container is 200 pixels wide, the above code will work fine unless you manually change width to be 201 or more.
I actually use this quite often, especially when I create any form of lists, listboxes or menu systems. Normally the child items is expected to cover the whole width of the parent (a row in a grid for example), with variable height. In that case I can just adjust the height and leave the width to the browser.
Pre calculate content
Like i mentioned above the most time-consuming tasks are size-changes and creation of elements. Of the two, creation of controls is by far the most time consuming for the document object model.
While the RTL gives you controls that are more or less compatible with Delphi or LCL, they have the downside of being quite heavy. There is a lot of code involved which gives the components great depth – but that depth comes at a cost.
What the browser does really fast however, is to create elements in bulk. Just stop and think about it for a while. If creating elements is so time-consuming – then why does pages appear almost instantly? Well, if you examine the webkit HTML renderer you will discover that parsing and creating elements en-mass is highly optimized. This is sadly not the case for the createElement() function that Smart uses to create components at runtime.
What this means is that its faster to create 1000 child elements as raw HTML and inject the text into the DOM – than it is to create 1000 controls. And not just fast: extremely fast!
But then we face a problem, namely that our RTL does something very useful for us: it keeps track of handles for each element and exposes the functionality as object pascal. If we just dump in a ton of HTML then how are we going to locate, use and manipulate our child elements?
A thin wrapper
This is where I tend to use a thin wrapper. This is a class designed to introduce as little code as possible – and only expose the underlying functionality of the document object model. The DOM is actually quite rich in functions even though they can be intimidating at first.
Here is a thin wrapper I use quite a lot.
unit SmartCL.ThinWrapper; interface uses System.Types, System.Colors, SmartCL.System, SmartCL.Graphics, SmartCL.Components, SmartCL.Fonts, SmartCL.Borders; type TElementArray = class external protected function GetItems(const Index : integer) : TControlHandle; external array; public property length: integer; property items[const Index : integer] : TControlHandle read GetItems; default; end; TWrappedElement = class private FHandle: TControlHandle; protected function ValueToInt(const Value: variant): integer; function IntToPixels(const Value: integer): string; function GetColor: TColor; procedure SetColor(const NewColor: TColor); public class function GetElementById(const Parent: TControlHandle; const ChildId: string): TControlHandle; overload; class function GetElementsByType(const Parent: TControlHandle; TagName: string; var Items: array of TControlHandle): boolean; overload; public property Handle: TControlHandle read FHandle; property Id: string read ( FHandle.id ) write ( Fhandle.id := Value ); property Title: string read ( FHandle.title ) write ( FHandle.title := Value ); // Offset property OffsetLeft: integer read (ValueToInt(FHandle.offsetLeft)) write (FHandle.offsetLeft := IntToPixels(Value)); property OffsetTop: integer read (ValueToInt(FHandle.offsetTop)) write (FHandle.offsetTop := IntToPixels(Value)); property OffsetWidth: integer read (ValueToInt(FHandle.offsetWidth)) write (FHandle.offsetWidth := IntToPixels(Value)); property OffsetHeight: integer read (ValueToInt(FHandle.offsetHeight)) write (FHandle.offsetHeight := IntToPixels(Value)); // Scroll property ScrollLeft: integer read (ValueToInt(FHandle.scrollLeft)) write (FHandle.scrollLeft := IntToPixels(Value)); property ScrollTop: integer read (ValueToInt(FHandle.scrollTop)) write (FHandle.scrollTop := IntToPixels(Value)); property ScrollWidth: integer read (ValueToInt(FHandle.scrollWidth)) write (FHandle.scrollWidth := IntToPixels(Value)); property ScrollHeight: integer read (ValueToInt(FHandle.scrollHeight)) write (FHandle.scrollHeight := IntToPixels(Value)); // Client property clientLeft: integer read (ValueToInt(FHandle.clientLeft)) write (FHandle.clientLeft := IntToPixels(Value)); property clientTop: integer read (ValueToInt(FHandle.clientTop)) write (FHandle.clientTop := IntToPixels(Value)); property clientWidth: integer read (ValueToInt(FHandle.clientWidth)) write (FHandle.clientWidth := IntToPixels(Value)); property clientHeight: integer read (ValueToInt(FHandle.clientHeight)) write (FHandle.clientHeight := IntToPixels(Value)); // Node property NodeName: string read (FHandle.nodeName); property NodeType: string read (FHandle.nodeType); property NodeValue: variant read (FHandle.nodeValue) write (FHandle.nodeValue := Value); property Children: TElementArray read ( TElementArray(FHandle.children) ); property InnerHTML: string read ( Handle.innerHTML ) write ( Handle.innerHTML := Value); property InnerText: string read ( Handle.innerText ) write ( Handle.innerText := Value); property Color: TColor read GetColor write SetColor; function Wrap(const Handle: TControlHandle): TWrappedElement; function GetElementById(const Id: string): TControlHandle; overload; function GetElementsByType(const TagName: string; var Items: array of TControlHandle): boolean; overload; procedure Click; constructor Create(TagId: string); overload; virtual; constructor Create(Parent: TControlHandle; TagId: string); overload; virtual; constructor Create(TagHandle: TControlHandle); overload; virtual; end; implementation //############################################################################# // TWrappedElement //############################################################################# constructor TWrappedElement.Create(TagId: String); begin inherited Create; FHandle := BrowserAPI.Body.GetChildById(TagId); end; constructor TWrappedElement.Create(TagHandle: TControlHandle); begin inherited Create; FHandle := TagHandle; end; constructor TWrappedElement.Create(Parent: TControlHandle; TagId: string); begin inherited Create; FHandle := Parent.GetChildById(TagId); end; procedure TWrappedElement.Click; begin FHandle.click(); end; function TWrappedElement.Wrap(const Handle: TControlHandle): TWrappedElement; begin result := TWrappedElement.Create( Handle ); end; function TWrappedElement.IntToPixels(const Value: integer): string; begin result := Value.ToString() + 'px'; end; function TWrappedElement.ValueToInt(const Value: variant): integer; begin asm if (@Value) { if (typeof(@Value) === "number") { @result = @Value } else { if (typeof(@Value) === "string") { @Value = parseInt(@Value); if (!isNaN(@Value)) @result = @Value; } } } else { @result = 0; } end; end; function TWrappedElement.GetColor: TColor; begin if (FHandle) then result := StrToColor( w3_getStyleAsStr(FHandle, 'backgroundColor') ) else result := clNone; end; procedure TWrappedElement.SetColor(const NewColor: TColor); begin if (FHandle) then begin if NewColor <> clNone then FHandle.style.backgroundColor := ColorToWebStr(NewColor) else FHandle.style.backgroundColor := 'transparent'; end; end; class function TWrappedElement.GetElementsByType(const Parent: TControlHandle; TagName: string; var Items: array of TControlHandle): boolean; begin if (parent) then begin asm @items = (@Parent).getElementsByTagName(@TagName); end; end else Items.Clear(); result := Items.Count > 0; end; function TWrappedElement.GetElementsByType(const TagName: string; var Items: array of TControlHandle): boolean; begin if (FHandle) then begin asm @items = (@FHandle).getElementsByTagName(@TagName); end; end else Items.Clear(); result := Items.Count > 0; end; class function TWrappedElement.GetElementById(const Parent: TControlHandle; const ChildId: string): TControlHandle; begin if (Parent) then begin result := Parent.getElementById(ChildId); if not (result) then result := Parent.getElementById( ChildId.ToLower().Trim() ); end else result := unassigned; end; function TWrappedElement.GetElementById(const Id: string): TControlHandle; begin if Id.Length > 0 then begin result := FHandle.getElementById(Id); if not (result) then result := FHandle.getElementById( Id.ToLower().Trim() ); end else result := unassigned; end; end.
If you are pondering how on earth is that going to help, here is how it works.
All Smart controls are simply JavaScript code designed to manage a real, underlying HTML element. The default element type TW3CustomControl creates is DIV. Controls like TW3TextBox overrides the function that creates this element and replace that with an input element instead. And other controls do the same.
So just because something is not visible to a fully blown TW3CustomControl, doesn’t mean it’s not there. And by using the wrapper we can easily hook rouge or non classified html elements without creating them.
Let’s for example say you inject a bit of HTML into a panel, like this:
procedure TForm1.MakeHTML; var x: integer; LHtml: string; begin // make X number of div items for x:=1 to 100 do begin LHtml += Format(' <div id="obj%d">Item #%d</div> ', [x,x]); end; // inject into our panel W3Panel1.InnerHTML := LHtml; end;
To access one of these DIV elements (which we now have 100 of), we can use our thin wrapper to make it programatically easier:
procedure TForm1.MakeHTML; var x: integer; LHtml: string; LItem: TWrappedElement; begin // make X number of div items for x:=1 to 100 do begin LHtml += Format(' <div id="obj%d">Item #%d</div> ', [x,x]); end; // inject into our panel W3Panel1.InnerHTML := LHtml; // Create wrapper for item #12 // We pass the handle to the parent (which is the form) // and the name. The class will find the element LItem := TWrappedElement.Create(W3Panel1.Handle, 'obj12'); end;
Voila! LItem can now be used just like any other Smart control. But remember that this is a thin wrapper, meaning that you are actually digging into the document object model directly.
I should mention a few words about the browser’s calculated stylesheet. One of the things you are going to notice is that width and height is not always going to be correct. This is not due to our code, but because the browser always regards your values as proposals, not absolutes.
So even if you set a control to say, 400px in width – depending on the situation the browser may find it more suitable to set 389px instead. And if you make the mistake of reading it back from the stylesheet – it will report 400px. But this is because the stylesheet is regarded as a proposal.
What you need to do is to write to the stylesheet, but read from the calculated styles. This is why the Smart RTL calls the w3_getStyleAsInt() function when reading these values.
Just so you know in case you think the wrapper is reporting wrong values. It’s not. The browser just works differently because of CSS. Cascading means that styles will merge together, so a button can have 50 gradients assigned to it – and they will all be amalgamated into one and represented in the calculated stylesheet as a single whole.
Other tricks
I could go on for days but I think these two will be handy for now. I would urge you to examine and learn how to use the GetElementByType() and GetElementById() so you get familiar with navigating the DOM like that. GetElementByType() is really cool – it allows you to extract a list of items based on type.
So to get all the DIV elements you can simply do:
var LDivs := LItem.GetElementByType(W3Panel1.Handle, 'div');
I should also mention that a thin-wrapper is only as good as you make it. The code above was never made to do the same as TW3CustomControl can. There is no cosy class wrapping of fonts, constraints, borders or reading of style properties. To enjoy these high-level RTL functions you will have to stick to the RTL.
But, for cases where you want to pre-generate relatively simple elements, like rows in a listbox or some form of menu items – a thin wrapper can mean the difference between useless and brilliant.
Oh, you might be interested in a “Styles” wrapper. I have only fleshed out a handfull of properties, but it does make low-level access a lot easier. If you finish it PM me. The documentation can be found here: http://www.w3schools.com/jsref/dom_obj_style.asp
TWrappedStyle = class external public // stretch|center|flex-start|flex-end|space-between|space-around|initial|inherit property alignContent: string; // stretch|center|flex-start|flex-end|baseline|initial|inherit property alignItems: string; // auto|stretch|center|flex-start|flex-end|baseline|initial|inherit property alignSelf: string; // http://www.w3schools.com/jsref/prop_style_animation.asp property animation: string; // time|initial|inherit property animationDelay: string; // normal|reverse|alternate|alternate-reverse|initial|inherit property animationDirection: string; // time|initial|inherit property animationDuration: string; // none|forwards|backwards|both|initial|inherit property animationFillMode: string; // number|infinite|initial|inherit property animationIterationCount: string; // none|keyframename|initial|inherit property animationName: string; // linear|ease|ease-in|ease-out|cubic-bezier(n, n, n, n)|initial|inherit property animationTimingFunction: string; // running|paused|initial|inherit property animationPlayState: string; // color image repeat attachment position size origin clip|initial|inherit property background: string; // scroll|fixed|local|initial|inherit property backgroundAttachment: string; // color|transparent|initial|inherit property backgroundColor: string; // url('URL')|none|initial|inherit property backgroundImage: string; // http://www.w3schools.com/jsref/prop_style_backgroundposition.asp property backgroundPosition: string; // repeat|repeat-x|repeat-y|no-repeat|initial|inherit property backgroundRepeat: string; // border-box|padding-box|content-box|initial|inherit property backgroundClip: string; // padding-box|border-box|content-box|initial|inherit property backgroundOrigin: string; end;
Well, more and more tricks will surface, so stay tuned guys!
Smart Pascal: BTree storage anyone?
Dictionaries are cool but they are only as good as the mechanisms supporting them. So I figured I could see if we could get more bang for the buck with a dedicated BTree class for Smart Pascal.
If you are wondering what on earth a BTree routine is, head over to Wikipedia and gander up on the technical side here: https://en.wikipedia.org/wiki/B-tree. In short it allows you to store some data connected to a string. Actually, its connected to a value identifier – but we can do a checksum of a string and use that as the key. So dictionary. Sort of.
What is special about the Smart Pascal version? Well, for one it doesn’t use pointers. And secondly you can save it to a stream. Typically classes like this don’t ship with a SaveToStream() method because it’s mostly intended to be used at runtime. But JavaScript have a few perks that force us to think differently.
Hope you enjoy it!
unit BTree; interface uses System.Types, System.Types.Convert, System.JSON, System.NameValuePairs, System.Streams, System.Stream.Writer, System.Stream.Reader; type TBTreeNode = class(JObject) public Ident: integer; Data: variant; Left: TBTreeNode; Right: TBTreeNode; end; TBTreeFileItem = record fiIdent: integer; fiData: variant; end; TBTreeProcess = procedure (const Node: TBTreeNode; var Cancel: boolean); TBTree = class(TObject) private FRoot: TBTreeNode; FCurrent: TBTreeNode; public property Root: TBTreeNode read FRoot; property Empty: boolean read ( FRoot = nil ); function Add(const Ident: integer; const Data: variant): TBTreeNode;overload;virtual; function Add(const Ident: string; const Data: variant): TBTreeNode;overload;virtual; function &Contains(const Ident: integer): boolean;overload;virtual; function &Contains(const Ident: string): boolean;overload;virtual; function Remove(const Ident: integer): boolean;overload;virtual; function Remove(const Ident: string): boolean;overload;virtual; function Read(const Ident: integer): variant;overload;virtual; function Read(const Ident: string): variant;overload;virtual; procedure Write(const Ident: string; const NewData: variant);overload;virtual; procedure Write(const Ident: integer; const NewData: variant);overload;virtual; procedure Clear;overload;virtual; procedure Clear(const Process: TBTreeProcess);overload;virtual; function ToArray: TVarArray; function ToString: string; function Size: integer; function ToJSON: string; procedure FromJSON(const Data: string); procedure SaveToStream(const Stream: TStream); procedure LoadFromStream(const Stream: TStream); procedure ForEach(const Process: TBTreeProcess); constructor Create; end; implementation (* These are the IO signatures used for storage *) const CNT_BTREE_STREAM_HEADER = $BABE0001; CNT_BTREE_ITEM_HEADER = $0001BABE; //############################################################################# // TBTree //############################################################################# constructor TBTree.Create; begin inherited Create; FRoot := nil; FCurrent := nil; end; procedure TBTree.Clear; begin FCurrent := nil; FRoot := nil; end; procedure TBTree.Clear(const Process: TBTreeProcess); begin ForEach(Process); Clear; end; function TBTree.ToJSON: string; begin if FRoot<>nil then result := Json.stringify(FRoot); end; procedure TBTree.FromJSON(const Data: string); begin if not empty then Clear; FRoot := TBTreeNode( JSON.Parse(data) ); end; procedure TBTree.SaveToStream(const Stream: TStream); var LWriter: TStreamWriter; LData: Array of TBTreeFileItem; LRaw: TByteArray; LItem: TBTreeFileItem; begin (* First, cache up all the data in an array. We need to do this in order to write the node-count on top of the file *) ForEach( procedure (const Node: TBTreeNode; var Cancel: boolean) begin LItem.fiIdent := Node.Ident; LItem.fiData := Node.Data; LData.add(LItem); end); LWriter := TStreamWriter.Create(Stream); try (* Write the magic identifier for the file *) LWriter.WriteInteger(CNT_BTREE_STREAM_HEADER); (* Write the number of items in the file *) LWriter.writeinteger(LData.Count); (* Now write each item *) for LItem in LData do begin (* Convert variant to byte-array *) LRaw := TDataType.VariantToBytes(LItem.fiData); (* Write the identifier for the record *) LWriter.WriteInteger(CNT_BTREE_ITEM_HEADER); (* Write the item-id *) LWriter.WriteInteger(LItem.fiIdent); (* Write the # of bytes in the data section *) LWriter.WriteInteger(LRaw.Count); (* Write the data section *) LWriter.Write(LRaw); end; finally LWriter.free; end; end; procedure TBTree.LoadFromStream(const Stream: TStream); var LReader: TStreamReader; LHead: integer; LId: integer; LBytes: integer; LRaw: TByteArray; LValue: variant; LCount: integer; begin (* Flush content if not empty *) if not Empty then Clear; (* Setup the reader *) LReader := TStreamReader.Create(Stream); try (* Validate the header *) LHead := LReader.ReadInteger; if LHead = CNT_BTREE_STREAM_HEADER then begin (* Get the count *) LCount := LReader.ReadInteger; while LCount>0 do begin LHead := LReader.ReadInteger; if LHead = CNT_BTREE_ITEM_HEADER then begin (* Read the identifier *) LId := LReader.ReadInteger; (* read the # of bytes for the variant *) LBytes := LReader.ReadInteger; (* Flush any lingering data *) LRaw.Clear; (* Read the raw data that makes up the variant *) if LBytes>0 then begin LRaw := LReader.read(LBytes); (* Convert from bytes to intrinsic *) LValue := TDatatype.BytesToVariant(LRaw); (* Add to tree *) self.Add(Lid, LValue); end; end else raise EW3Exception.CreateFmt('Invalid item header, expected %d not %d', [CNT_BTREE_ITEM_HEADER,LHead]); dec(LCount); end; end else raise EW3Exception.CreateFmt('Invalid stream header, expected %d not %d', [CNT_BTREE_STREAM_HEADER,LHead]); finally LReader.free; end; end; function TBTree.Size: integer; var LCount: integer; begin ForEach( procedure (const Node: TBTreeNode; var Cancel: boolean) begin inc(LCount); end); result := LCount; end; function TBTree.ToArray: TVarArray; var Data: TVarArray; begin ForEach( procedure (const Node: TBTreeNode; var Cancel: boolean) begin Data.add(Node.Ident); end); result := data; end; function TBTree.ToString: string; begin for var x in ToArray do begin result += TVariant.AsString(x) + #13; end; end; function TBTree.Add(const Ident: string; const Data: variant): TBTreeNode; begin result := Add( TString.CalcCRC(Ident), Data); end; function TBTree.Add(const Ident: integer; const Data: variant): TBTreeNode; var LNode: TBTreeNode; begin LNode := new TBTreeNode; LNode.Ident := Ident; LNode.Data := data; if (FRoot = nil) then FRoot := LNode; FCurrent := FRoot; while (true) do begin if (Ident < FCurrent.Ident) then begin if (FCurrent.left = nil) then begin FCurrent.left := LNode; break; end else FCurrent := FCurrent.left; end else if (Ident > FCurrent.Ident) then begin if (FCurrent.right = nil) then begin FCurrent.right := LNode; break; end else FCurrent := FCurrent.right; end else break; end; result := LNode; end; function TBTree.Read(const Ident: string): variant; begin result := Read( TString.CalcCRC(Ident) ); end; function TBTree.Read(const Ident: integer): variant; begin Result := unassigned; FCurrent := FRoot; while (FCurrent <> nil) do begin if (Ident < FCurrent.Ident) then FCurrent := Fcurrent.left else if (Ident > Fcurrent.Ident) then FCurrent := FCurrent.Right else begin result := FCUrrent.Data; break; end end; end; procedure TBTree.Write(const Ident: string; const NewData: variant); begin Write(TString.CalcCRC(Ident), NewData); end; procedure TBTree.Write(const Ident: integer; const NewData: variant); begin FCurrent := FRoot; while (FCurrent <> nil) do begin if (Ident < FCurrent.Ident) then FCurrent := Fcurrent.left else if (Ident > Fcurrent.Ident) then FCurrent := FCurrent.Right else begin FCurrent.Data := NewData; break; end end; end; function TBTree.&Contains(const Ident: string): boolean; begin result := &Contains(TString.CalcCRC(Ident)); end; function TBTree.&Contains(const Ident: integer): boolean; begin Result := false; if FRoot <> nil then begin FCurrent := FRoot; while ( (not Result) and (FCurrent <> nil) ) do begin if (Ident < FCurrent.Ident) then FCurrent := Fcurrent.left else if (Ident > Fcurrent.Ident) then FCurrent := FCurrent.Right else begin Result := true; end end; end; end; function TBTree.Remove(const Ident: string): boolean; begin result := Remove(TString.CalcCRC(Ident)); end; function TBTree.Remove(const Ident: integer): boolean; var LFound: boolean; LParent: TBTreeNode; LChildCount: integer; LReplacement, LReplacementParent: TBTreeNode; begin LFound := false; LParent := nil; FCurrent := FRoot; while (not LFound) and (FCurrent<>nil) do begin if (Ident < FCurrent.Ident) then begin LParent := FCurrent; FCurrent:= FCurrent.left; end else if (Ident > FCurrent.Ident) then begin LParent := FCurrent; FCurrent := FCurrent.right; end else begin LFound := true; end; if (LFound) then begin LChildCount:=0; if (FCurrent.left<>nil) then inc(LChildCount); if (FCurrent.right<>nil) then inc(LChildCount); //LChildCount := (if FCurrent.left <> nil then 1 else 0) + (if FCurrent.right <> nil then 1 else 0); if (FCurrent = FRoot) then begin case (LChildCOunt) of 0: FRoot := nil; 1: FRoot := if FCurrent.right = nil then FCurrent.left else FCurrent.Right; 2: begin LReplacement := FRoot.left; while (LReplacement.right <> nil) do begin LReplacementParent := LReplacement; LReplacement := LReplacement.right; end; if (LReplacementParent <> nil) then begin LReplacementParent.right := LReplacement.Left; LReplacement.right := FRoot.Right; LReplacement.left := FRoot.left; end else LReplacement.right := FRoot.right; end; end; FRoot := LReplacement; end else begin case LChildCount of 0: if (FCurrent.Ident < LParent.Ident) then Lparent.left := nil else LParent.right := nil; 1: if (FCurrent.Ident < LParent.Ident) then begin if (FCurrent.Left = NIL) then LParent.left := FCurrent.Right else LParent.Left := FCurrent.Left; end else begin if (FCurrent.Left = NIL) then LParent.right := FCurrent.Right else LParent.right := FCurrent.Left; end; 2: begin LReplacement := FCurrent.left; LReplacementParent := FCurrent; while (LReplacement.right <> nil) do begin LReplacementParent := LReplacement; LReplacement := LReplacement.right; end; LReplacementParent.right := LReplacement.left; LReplacement.right := FCurrent.right; LReplacement.left := FCurrent.left; if (FCurrent.Ident < LParent.Ident) then LParent.left := LReplacement else LParent.right := LReplacement; end; end; end; end; end; result := LFound; end; procedure TBTree.ForEach(const Process: TBTreeProcess); function ProcessNode(const Node: TBTreeNode): boolean; begin (* Default to false. If true is defined here, the operation has been canceled by the user *) result := false; if (Node <> nil) then begin (* Process left path first *) if (node.left <> nil) then begin result := ProcessNode(Node.left); if result then exit; end; (* process midpoint *) Process(Node, result); if result then exit; (* current right path *) if (Node.right <> nil) then begin result:=ProcessNode(Node.right); if result then exit; end; end; end; begin ProcessNode(FRoot); end; end.