1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-24 08:18:52 -05:00

Setting test base

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@376 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2010-01-05 18:35:42 +00:00
parent 6eb1f5af23
commit 906d4c9b98
8 changed files with 6123 additions and 0 deletions

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,296 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<General>
<Flags>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<MainUnit Value="0"/>
<TargetFileExt Value=""/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="13">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<UsageCount Value="33"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<CursorPos X="30" Y="172"/>
<TopLine Value="154"/>
<EditorIndex Value="0"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../SAMufasaGUI/colourhistory.pas"/>
<ComponentName Value="ColourHistoryForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="colourhistory"/>
<CursorPos X="26" Y="184"/>
<TopLine Value="156"/>
<UsageCount Value="16"/>
</Unit2>
<Unit3>
<Filename Value="../../../../Documents/fpc/packages/fcl-xml/src/dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="25" Y="115"/>
<TopLine Value="97"/>
<UsageCount Value="9"/>
</Unit3>
<Unit4>
<Filename Value="../SAMufasaGUI/framefunctionlist.pas"/>
<ComponentName Value="FunctionListFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="framefunctionlist"/>
<CursorPos X="70" Y="204"/>
<TopLine Value="184"/>
<UsageCount Value="16"/>
</Unit4>
<Unit5>
<Filename Value="settings.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="settings"/>
<CursorPos X="75" Y="164"/>
<TopLine Value="142"/>
<EditorIndex Value="1"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="../../Units/MMLAddon/updater.pas"/>
<UnitName Value="updater"/>
<CursorPos X="2" Y="88"/>
<TopLine Value="55"/>
<EditorIndex Value="3"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../../../Documents/lazarus/lcl/comctrls.pp"/>
<UnitName Value="ComCtrls"/>
<CursorPos X="77" Y="1920"/>
<TopLine Value="1902"/>
<EditorIndex Value="2"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="../../../../Documents/lazarus/lcl/include/treeview.inc"/>
<CursorPos X="72" Y="2253"/>
<TopLine Value="2219"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<Filename Value="../../../../Documents/fpc/rtl/inc/strings.pp"/>
<UnitName Value="strings"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="78"/>
<UsageCount Value="8"/>
</Unit9>
<Unit10>
<Filename Value="../../../../Documents/fpc/rtl/objpas/strutils.pp"/>
<UnitName Value="strutils"/>
<CursorPos X="1" Y="176"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="../../../../Documents/fpc/packages/unixutil/src/unixutils.pp"/>
<UnitName Value="UnixUtils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="../../../../Documents/lazarus/lcl/include/control.inc"/>
<CursorPos X="1" Y="2289"/>
<TopLine Value="2271"/>
<UsageCount Value="9"/>
</Unit12>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="130" Column="15" TopLine="113"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="97" Column="5" TopLine="79"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="96" Column="14" TopLine="78"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="79" Column="33" TopLine="61"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="96" Column="12" TopLine="78"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="79" Column="12" TopLine="61"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="86" Column="46" TopLine="68"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="167" Column="23" TopLine="139"/>
</Position8>
<Position9>
<Filename Value="settings.pas"/>
<Caret Line="141" Column="6" TopLine="111"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="167" Column="32" TopLine="148"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="196" Column="5" TopLine="166"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="24" Column="1" TopLine="4"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="197" Column="1" TopLine="164"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="194" Column="30" TopLine="166"/>
</Position14>
<Position15>
<Filename Value="unit1.pas"/>
<Caret Line="20" Column="30" TopLine="12"/>
</Position15>
<Position16>
<Filename Value="settings.pas"/>
<Caret Line="156" Column="3" TopLine="136"/>
</Position16>
<Position17>
<Filename Value="settings.pas"/>
<Caret Line="84" Column="19" TopLine="59"/>
</Position17>
<Position18>
<Filename Value="settings.pas"/>
<Caret Line="81" Column="11" TopLine="72"/>
</Position18>
<Position19>
<Filename Value="settings.pas"/>
<Caret Line="173" Column="1" TopLine="161"/>
</Position19>
<Position20>
<Filename Value="settings.pas"/>
<Caret Line="184" Column="3" TopLine="166"/>
</Position20>
<Position21>
<Filename Value="unit1.pas"/>
<Caret Line="154" Column="1" TopLine="137"/>
</Position21>
<Position22>
<Filename Value="settings.pas"/>
<Caret Line="76" Column="3" TopLine="56"/>
</Position22>
<Position23>
<Filename Value="unit1.pas"/>
<Caret Line="65" Column="32" TopLine="39"/>
</Position23>
<Position24>
<Filename Value="unit1.pas"/>
<Caret Line="42" Column="6" TopLine="42"/>
</Position24>
<Position25>
<Filename Value="unit1.pas"/>
<Caret Line="70" Column="2" TopLine="56"/>
</Position25>
<Position26>
<Filename Value="unit1.pas"/>
<Caret Line="75" Column="8" TopLine="62"/>
</Position26>
<Position27>
<Filename Value="unit1.pas"/>
<Caret Line="80" Column="1" TopLine="52"/>
</Position27>
<Position28>
<Filename Value="unit1.pas"/>
<Caret Line="79" Column="3" TopLine="51"/>
</Position28>
<Position29>
<Filename Value="unit1.pas"/>
<Caret Line="173" Column="19" TopLine="143"/>
</Position29>
<Position30>
<Filename Value="settings.pas"/>
<Caret Line="38" Column="24" TopLine="24"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, LResources, settings
{ you can add units after this };
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
begin
{$I project1.lrs}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1 @@
MAINICON ICON "project1.ico"

View File

@ -0,0 +1,315 @@
unit settings;
{$mode objfpc}
interface
uses
Classes, SysUtils, ComCtrls;
type
// remove later
TStringArray = Array Of String;
TSettingData = class(TObject)
public
Val: String;
constructor Create;
destructor Destroy; override;
end;
TMMLSettings = class(TObject)
public
constructor Create(aNodes: TTreeNodes);
destructor Destroy; override;
private
Nodes: TTreeNodes;
function KeyNameToKeys(KeyName: String): TStringArray;
function WalkToNode(KeyName: String): TTreeNode;
function GetNodePath(Node: TTreeNode): String;
public
function ListKeys(KeyName: String): TStringArray;
function KeyExists(KeyName: String): Boolean;
function IsKey(KeyName: String): Boolean;
function IsDirectory(KeyName: String): Boolean;
procedure SetKey(KeyName: String; KeyValue: String);
function CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean;
function GetKeyValue(KeyName: String): String;
end;
implementation
uses
strutils;
constructor TSettingData.Create;
begin
inherited;
Val := '';
end;
destructor TSettingData.Destroy;
begin
Val := '';
inherited;
end;
constructor TMMLSettings.Create(aNodes: TTreeNodes);
begin
Self.Nodes := aNodes;
end;
destructor TMMLSettings.Destroy;
begin
Nodes := nil;
inherited;
end;
function TMMLSettings.KeyNameToKeys(KeyName: String): TStringArray;
// yay for SRL!
function srl_Explode(str, del: string): TStringArray;
var
i, l, dL: Integer;
begin
i := 0;
l := -1;
SetLength(Result, 0);
if (str = '') then
Exit;
dL := Length(del) - 1;
repeat
Inc(l);
SetLength(Result, l + 1);
i := Pos(del, str);
if i <= 0 then
Break;
Result[l] := Copy(str, 1, i - 1);
Delete(str, 1, i + dL);
until false;
Result[l] := Copy(str, 1, Length(str));
end;
begin
Result := srl_Explode(KeyName, '/');
end;
function TMMLSettings.WalkToNode(KeyName: String): TTreeNode;
var
N: TTreeNode;
i: Integer;
S: TStringArray;
begin
Result := nil;
if KeyName[length(KeyName)]='/' then setlength(KeyName,length(KeyName)-1);
S := KeyNameToKeys(KeyName);
if not assigned(s) then
Exit(nil);
N := Nodes.GetFirstNode;
i := 0;
while N <> nil do
begin
if N.Text = s[i] then
begin
inc(i);
if i = length(s) then
break;
n := N.GetFirstChild;
end else
n := n.GetNextSibling;
end;
Result := N;
end;
function TMMLSettings.GetNodePath(Node: TTreeNode): String;
var
N: TTreeNode;
s: TStringArray;
i: Integer;
begin
if Node = nil then
Exit('');
N := Node;
setlength(s, 0);
while N <> nil do
begin
setlength(s,length(s) + 1);
s[high(s)] := N.Text;
N := N.Parent;
end;
result := '';
for i := high(s) downto 0 do
result := result + s[i] + '/';
end;
function TMMLSettings.ListKeys(KeyName: String): TStringArray;
var
N: TTreeNode;
i: Integer;
S: TStringArray;
begin
SetLength(Result, 0);
N := WalkToNode(KeyName);
if N <> nil then
N := N.GetFirstChild;
while N <> nil do
begin
setlength(result,length(result)+1);
result[high(result)] := N.Text;
N := N.GetNextSibling;
end;
end;
function TMMLSettings.KeyExists(KeyName: String): Boolean;
begin
Result := WalkToNode(KeyName) <> nil;
end;
function TMMLSettings.IsKey(KeyName: String): Boolean;
var
N: TTreeNode;
i: Integer;
begin
N := WalkToNode(KeyName);
if N = nil then
Exit(False);
i := 0;
N := N.GetNextSibling;
while N <> nil do
begin
if N.Text <> 'Value' then
begin
writeln(N.text);
inc(i);
end;
N := N.GetNextSibling;
end;
Exit(i = 0);
end;
function TMMLSettings.IsDirectory(KeyName: String): Boolean;
var
N: TTreeNode;
begin
N := WalkToNode(KeyName);
if N <> nil then
Exit(N.HasChildren);
Exit(False);
end;
function TMMLSettings.GetKeyValue(KeyName: String): String;
var
N: TTreeNode;
begin
if IsKey(KeyName) then
Exit('');
N := WalkToNode(KeyName);
if N <> nil then
if N.GetFirstChild <> nil then
if assigned(n.GetFirstChild.Data) then
Exit(TSettingData(n.GetFirstChild.Data).Val);
Exit('');
end;
function TMMLSettings.CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean;
var
N, newN, nParent: TTreeNode;
Path: TStringArray;
NewPath: String;
i: Integer;
begin
if KeyExists(KeyName) then
begin
writeln('Key: ' + KeyName + ' exists');
Exit(False);
end;
NewPath := '';
N := nil;
nParent := Nodes.GetFirstNode;
Path := KeyNameToKeys(KeyName);
if length(path) < 2 then
begin
writeln('Path too short!');
exit(false);
end;
if path[0] <> nParent.Text then
begin
writeln('First key doesn''t match. First key should always match');
end;
for i := 0 to length(Path) - 2 do
begin
if Path[i] = '' then
begin
writeln('Invalid Key Path / Name');
exit(false);
end;
NewPath := NewPath + Path[i] + '/';
N := WalkToNode(NewPath);
if (N = nil) and (not CreatePath) then
begin
writeln('(N = nil) and (not CreatePath)');
exit(false);
end;
if (N = nil) and CreatePath then
begin
newN := TTreeNode.Create(Nodes);
newN.Text := Path[i];
if (nParent = nil) then
begin
writeln('This shouldn''t happen...');
newN.MoveTo(Nodes.GetFirstNode, naAddChild);
nParent := newN;
end
else
begin
newN.MoveTo(nParent, naAddChild);
nParent := newN;
end;
end;
if N <> nil then
nParent := N;
end;
if nParent = nil then
exit(false);
newN := TTreeNode.Create(Nodes);
newN.Text := Path[High(Path)];
newN.MoveTo(nParent, naAddChild);
end;
procedure TMMLSettings.SetKey(KeyName: String; KeyValue: String);
begin
if IsKey(KeyName) then
Exit;
end;
end.

View File

@ -0,0 +1,46 @@
object Form1: TForm1
Left = 264
Height = 467
Top = 183
Width = 734
ActiveControl = TreeView1
Caption = 'Form1'
ClientHeight = 467
ClientWidth = 734
LCLVersion = '0.9.29'
object TreeView1: TTreeView
Left = 16
Height = 376
Top = 24
Width = 344
DefaultItemHeight = 19
TabOrder = 0
end
object SaveButton: TButton
Left = 272
Height = 25
Top = 432
Width = 88
Caption = 'SaveButton'
OnClick = SaveButtonClick
TabOrder = 1
end
object LoadButton: TButton
Left = 16
Height = 25
Top = 432
Width = 91
Caption = 'LoadButton'
OnClick = LoadButtonClick
TabOrder = 2
end
object ListView1: TListView
Left = 376
Height = 376
Top = 24
Width = 336
Columns = <>
ItemIndex = -1
TabOrder = 3
end
end

207
Projects/settings/unit1.pas Normal file
View File

@ -0,0 +1,207 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls, StdCtrls, xml2, XMLRead, XMLWrite, DOM;
type
{ TForm1 }
TForm1 = class(TForm)
ListView1: TListView;
SaveButton: TButton;
LoadButton: TButton;
TreeView1: TTreeView;
procedure SaveButtonClick(Sender: TObject);
procedure LoadButtonClick(Sender: TObject);
private
{ private declarations }
procedure LoadFromXML(tree: TTreeView; XMLDoc: TXMLDocument);
procedure SaveToXML(s: String);
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
uses
settings;
procedure WriteXMLData(n: TTreeNode;
XMLNode: TDOMNode; XMLDoc: TXMLDocument;
var XMLChild: TDOMNode; var C: Integer);
var
DDataNode, DataNode: TDOMNode;
begin
XMLChild := XMLDoc.CreateElement(n.Text);
Inc(C);
XMLNode.AppendChild(XMLChild);
end;
procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument;
var C: Integer);
var
N: TTreeNode;
XMLChild: TDOMNode;
begin
N := Node.GetFirstChild;
while assigned(n) do
begin
WriteXMLData(n, XMLNode, XMLDoc, XMLChild, C);
WalkTree(n, XMLChild, XMLDoc, C);
n := n.GetNextSibling;
end;
end;
procedure TForm1.SaveToXML(s: String);
var
XMLDoc: TXMLDocument;
RootNode: TDOMNode;
C: Integer;
begin
XMLDoc := TXMLDocument.Create;
RootNode := XMLDoc.CreateElement('Settings');
XMLDoc.AppendChild(RootNode);
RootNode := XMLDoc.DocumentElement;
C := 0;
if TreeView1.Items.GetFirstNode <> nil then
WalkTree(TreeView1.Items.GetFirstNode, RootNode, XMLDoc, C);
{ writeln(TreeView1.Items.TopLvlCount);
for i := 0 to TreeView1.Items.TopLvlCount -1 do
begin
WriteXMLData(TreeView1.Items.TopLvlItems[i], RootNode, XMLDoc, XMLChild, C);
WalkTree(TreeView1.Items.TopLvlItems[i], XMLChild, XMLDoc, C);
end; }
WriteXMLFile(XMLDoc, s);
XMLDoc.Free;
end;
procedure TForm1.LoadFromXML(tree: TTreeView; XMLDoc: TXMLDocument);
var
iNode: TDOMNode;
procedure ProcessNode(Node: TDOMNode; TreeNode: TTreeNode);
var
cNode: TDOMNode;
s: string;
d: TSettingData;
begin
if Node = nil then Exit; // Stops if reached a leaf
// Adds a node to the tree
if (Node.NodeType = 3) then
s := 'Data'
else
s := Node.NodeName;
TreeNode := tree.Items.AddChild(TreeNode, s);
if (Node.NodeType = 3) then
begin
d := TSettingData.Create;
D.Val := Node.NodeValue;
TreeNode.Data := D;
TreeNode.Text := 'Value';
end;
// Goes to the child node
cNode := Node.FirstChild;
// Processes all child nodes
while cNode <> nil do
begin
ProcessNode(cNode, TreeNode);
cNode := cNode.NextSibling;
end;
end;
begin
iNode := XMLDoc.DocumentElement;
while iNode <> nil do
begin
ProcessNode(iNode, nil); // Recursive
iNode := iNode.NextSibling;
end;
end;
{ TForm1 }
procedure TForm1.SaveButtonClick(Sender: TObject);
var
sett: TMMLSettings;
s: TStringArray;
i: Integer;
begin
sett := TMMLSettings.Create(TreeView1.Items);
if sett.KeyExists('') then
writeln('Tree exists');
if sett.KeyExists('Settings/a/b/c') then
writeln('Settings exists');
{writeln(sett.GetKeyValue('Settings/hoi0/Item1/Item2/Item3/wattt')); }
sett.CreateKey('Settings/a/b/c', true);
if sett.iskey('Settings/a/b/c') then
writeln('is key');
s := sett.ListKeys('Settings');
for i := 0 to high(s) do
writeln(s[i]);
{ ss:='Settings' + '/' + s[0];
while length(s) > 0 do
begin
s := sett.ListKeys(ss);
if(length(s)>0) then
ss:=ss +'/' + s[0];
end; }
sett.Free;
SaveToXML('settings.xml');
end;
procedure TForm1.LoadButtonClick(Sender: TObject);
var
doc: TXMLDocument;
begin
if not FileExists('settings.xml') then
begin
TreeView1.Items.Clear;
SaveToXML('settings.xml');
end;
ReadXMLFile(doc, 'settings.xml');
TreeView1.Items.Clear;
LoadFromXML(TreeView1, doc);
end;
initialization
{$I unit1.lrs}
end.