// © Vers a Versa
// by Theo Heselmans
// Date : 20 nov 1993
constant kVersion := "v. 1.0d2";
constant kTitle := "Souped-Up";
constant kAppSymbol := '|Souped-Up:VaV|;
constant kPackageName := "Souped-Up:VaV";
constant kAppObject := '["Souped-Up","Souped-Ups"];
// ---- End Project Data ----
Main :=
{TheSoupCount: nil,
TheCurrent: nil,
TheSoup: nil,
Spaces:
func(LevelNr)
begin
if LevelNr=1 then
""
else
SubStr(" ",0,(LevelNr-2)*6) & "--";
end,
TheData: nil,
PrintOneObject:
func(Slot,Object,Level)
begin
if Level <= TheLevel then begin
if StrLen(TheData) >1000 then return;
local Temp,Prefix;
local PrimeClass:=PrimClassOf(Object);
local Class:=ClassOf(Object);
Prefix:=if Slot = nil then "" else :Spaces(Level) & Slot & ":" & unicodeHT;
if PrimeClass='Immediate or Class='String or Class='Symbol then
begin
//check if it could be a date (range 1923-2018)
Temp:=if Class='Int and Object > 10000000 and Object < 60000000 then ShortDate(Object) && date(Object).year else Object;
:Append(Prefix & :PrintObject(Temp),if Slot then unicodeCR else ", ");
end;
else if Class = 'Array or PrimeClass = 'Array then
begin
:Append(Prefix & length(object) & "[",nil);
foreach value in Object do
:PrintOneObject(nil,Value,Level+1);
:Append("]",unicodeCR);
end;
else if Class = 'Frame or PrimeClass = 'Frame then
begin
:Append(Prefix & length(object) & "{Frame}",unicodeCR);
foreach slotname,value in Object do
:PrintOneObject(sPrintObject(Slotname),Value,Level+1);
end;
else
begin
Temp:=:PrintObject(object);
if strEqual(Temp,"") then
:Append(Prefix & "<Unknown: " & sPrintObject(PrimeClass) & ", " & sPrintObject(Class) & ">",if Slot then unicodeCR else ", ");
else
:Append(Prefix & Temp,if Slot then unicodeCR else ", ");
end;
end;
end,
viewBounds: {left: 0, top: 0, right: 240, bottom: 336},
_proto: protoapp,
TheStore: nil,
TheIndex: nil,
TheLevel: 1,
TheCursor: nil,
TheEntry: nil,
viewScrollDownScript:
func()
begin
if TheCurrent<TheSoupCount then begin
TheCursor:Next();
TheCurrent:=TheCurrent+1;
:GetEntry();
end;
end,
title: "Souped-Up",
viewScrollUpScript:
func()
begin
if TheCurrent>1 then begin
TheCursor:Prev();
TheCurrent:=TheCurrent-1;
:GetEntry();
end;
end,
PrintObject:
func(object)
begin
if object = nil then return "NIL";
if object = true then "TRUE"
else sPrintObject(Object);
end,
viewSetupFormScript:
func()
begin
Title:=kTitle;
local sysSoup := GetStores()[0]:GetSoup(ROM_SystemSoupName);
local cursor := Query(sysSoup,{type: 'index, indexPath: 'tag, startKey: kPackageName});
prefsEntry := cursor:Entry();
if NOT (prefsEntry AND StrEqual(prefsEntry.tag,kPackageName)) then
prefsEntry := sysSoup:Add({tag: kPackageName, StoreNr:0, SoupNr:0, IndexNr:0, EntryNr:1, LevelNr:1});
end,
prefsEntry: nil,
debug: "Main",
GetEntry:
func()
begin
:Append(nil,nil);
prefsEntry.EntryNr:=TheCurrent;
TheEntry:=clone(TheCursor:Entry());
if TheEntry = nil then
Count.Text:="No Data";
else begin
foreach slot,value in TheEntry do begin
:PrintOneObject(sPrintObject(Slot),Value,1);
if StrLen(TheData) >1000 then begin
:Append("------------",UnicodeCR);
:Append("<More Slots here>",UnicodeCR);
:Append("<Due to Memory problem, have to stop here>",nil);
Break;
end;
end;
EntryUndoChanges(TheEntry);
Count.Text:=NumberStr(TheCurrent)&" of "&NumberStr(TheSoupCount);
end;
ListView.ViewOriginY:=0;
setvalue(List,'text,TheData & " ");
TheData:=nil;
TheEntry:=nil;
setvalue(List,'viewbounds,List.viewbounds); //to force recalc of bounds (bug in clparagraphview)
ListView.ViewMaxY := List:LocalBox().bottom - ListView:LocalBox().bottom + 1;
Count:Dirty();
EntryChange(prefsEntry); // save at the end, so in case of a memory error, previous prefs is restored
end,
Append:
func(String,Suffix)
begin
if String=nil then
TheData:="";
else begin
TheData:=Stringer([TheData,if Suffix then Stringer([String,Suffix]) else String]);
end;
end,
CountSoup:
func ()
begin
local count:=1, cursor:=TheCursor:Clone();
cursor:Reset();
if cursor:Entry() = NIL then
TheSoupCount:= 0;
else begin
while cursor:Next() do count := count + 1;
TheSoupCount:=Count;
end;
end
};
ListView := /* child of Main */
{viewflags: 67108897,
viewFormat: 336,
viewBounds: {top: 30, left: 1, right: -15, bottom: 303},
viewJustify: 48,
viewOriginY: 0,
viewMaxY: nil,
ViewScrollAmount: 100,
viewclass: 74,
debug: "ListView"
};
List := /* child of ListView */
{viewBounds: {top: 1, left: 2, right: -2, bottom: 253},
viewfont: ROM_fontSystem9,
viewflags: 11,
viewFormat: 131073,
viewJustify: 48,
text: "Entry Info",
tabs: [70],
_proto: protostatictext,
debug: "List"
};
// View List is accesible from Main
// View ListView is accesible from Main
Level := /* child of Main */
{viewBounds: {left: 159, top: 305, right: 241, bottom: 319},
labelCommands: ["1","2","3","4"],
viewSetupDoneScript:
func()
begin
TheLevel:=prefsEntry.LevelNr;
:UpdateText(Labelcommands[TheLevel-1]);
end,
labelActionScript:
func(cmd)
begin
TheLevel:=cmd+1;
prefsEntry.LevelNr:=TheLevel;
:GetEntry();
end,
text: "Level",
_proto: protolabelpicker,
debug: "Level"
};
// View Level is accesible from Main
Store := /* child of Main */
{viewBounds: {left: 3, top: 15, right: 103, bottom: 29},
labelCommands: ["Internal"],
text: "Store",
labelActionScript:
func(cmd)
begin
TheStore:=GetStores()[cmd];
prefsEntry.StoreNr:=cmd;
prefsEntry.SoupNr:=0;
prefsEntry.IndexNr:=0;
prefsEntry.EntryNr:=1;
Soup:Getsoups();
Index:GetIndexes();
Index:GetData();
end,
viewSetupDoneScript:
func()
begin
local Counter, Stores:=array(0,Nil), NrStores:=Length(GetStores())-1;
for Counter:=0 to NrStores do
AddArraySlot(Stores,GetStores()[Counter]:GetName());
LabelCommands:=Stores;
if prefsEntry.StoreNr>NrStores then prefsEntry.StoreNr:=0;
:Updatetext(LabelCommands[prefsEntry.StoreNr]);
TheStore:=GetStores()[prefsEntry.StoreNr];
end,
_proto: protolabelpicker,
debug: "Store"
};
// View Store is accesible from Main
Soup := /* child of Main */
{viewBounds: {left: 105, top: 15, right: 241, bottom: 29},
labelCommands: ["System"],
text: "Soup",
GetSoups:
func()
begin
LabelCommands:=TheStore:GetSoupNames();
if prefsEntry.SoupNr > (Length(LabelCommands)-1) then prefsEntry.SoupNr:=0;
TheSoup:=TheStore:GetSoup(LabelCommands[prefsEntry.SoupNr]);
:Updatetext(LabelCommands[prefsEntry.SoupNr]);
end,
viewSetupDoneScript:
func()
begin
:GetSoups();
end,
labelActionScript:
func(cmd)
begin
TheSoup:=TheStore:GetSoup(LabelCommands[cmd]);
prefsEntry.SoupNr:=cmd;
prefsEntry.IndexNr:=0;
prefsEntry.EntryNr:=1;
Index:GetIndexes();
Index:GetData();
end,
_proto: protolabelpicker,
debug: "Soup"
};
// View Soup is accesible from Main
Index := /* child of Main */
{viewBounds: {left: 3, top: 305, right: 157, bottom: 319},
labelCommands: ["index 1","index 2"],
GetIndexes:
func()
begin
local List:=array(0,Nil), Counter, Indexes:=TheSoup:GetIndexes();
if Indexes <> nil then
for Counter:=0 to length(Indexes)-1 do
AddArraySlot(List,sPrintobject(Indexes[Counter].path));
else List:=[""];
Labelcommands:=list;
if prefsEntry.IndexNr>(Length(Indexes)-1) then prefsEntry.IndexNr:=0;
:UpdateText(List[prefsEntry.IndexNr]);
TheIndex:=if Indexes = nil then nil else List[prefsEntry.IndexNr];
end,
labelActionScript:
func(cmd)
begin
TheIndex:=labelcommands[cmd];
prefsEntry.IndexNr:=cmd;
prefsEntry.EntryNr:=1;
:GetData();
end,
text: "Index",
viewSetupDoneScript:
func()
begin
:GetIndexes();
:GetData();
end,
GetData:
func()
begin
TheCursor:=query(TheSoup,{type:'index, indexpath: (if TheIndex then intern(TheIndex) else 'uniqueID)});
:CountSoup();
if prefsEntry.EntryNr> TheSoupCount then prefsEntry.EntryNr:=1;
TheCurrent:=prefsEntry.EntryNr;
if TheCurrent>1 then TheCursor:Move(TheCurrent-1);
:GetEntry();
end,
_proto: protolabelpicker,
debug: "Index"
};
// View Index is accesible from Main
About := /* child of Main */
{viewBounds: {left: 4, top: 38, right: 192, bottom: 234},
viewSetupDoneScript:
func()
begin
VersionField.Text:=kVersion;
end,
_proto: protofloatngo,
debug: "About"
};
_view000 := /* child of About */
{
text:
"Souped-Up lets you browse through any Soup entry by entry, independent of the soups structure.\nThanks to Matthew Dixon Cowles, from whom I borrowed some ideas in his 'Pour' code.\n\nA free tool offered to you by...\n\nTheo Heselmans\n\u00A9\u Vers a Versa, 1993\n"
,
viewBounds: {left: 8, top: 34, right: 192, bottom: 184},
viewJustify: 0,
_proto: protostatictext
};
VavIcon := /* child of About */
{viewflags: 3,
icon: GetPictAsBits("VaV Pict", nil),
viewFormat: nil,
viewBounds: {left: 8, top: 2, right: 56, bottom: 34},
viewclass: 76,
debug: "VavIcon"
};
VersionField := /* child of About */
{text: "v. 1.0",
viewBounds: {left: 8, top: 184, right: 64, bottom: 205},
viewfont: simpleFont9,
_proto: protostatictext,
debug: "VersionField"
};
// View VersionField is accesible from About
// View About is accesible from Main
Info := /* child of Main */
{viewBounds: {top: -16, left: 40, right: 53, bottom: -3},
buttonClickScript:
func()
begin
About:Open();
end,
viewJustify: 134,
icon: GetPictAsBits("Info", nil),
_proto: protopicturebutton,
debug: "Info"
};
// View Info is accesible from Main
Count := /* child of Main */
{viewBounds: {top: -16, left: 0, right: 60, bottom: -3},
text: "1 of x",
viewJustify: 8388758,
viewFormat: 337,
_proto: protostatictext,
debug: "Count"
};
// View Count is accesible from Main
Up := /* child of Main */
{viewBounds: {left: 226, top: 146, right: 242, bottom: 162},
viewFormat: 1,
buttonPressedScript:
func()
begin
if ListView.ViewOriginY>0 then begin
local NewY:=ListView.ViewOriginY-ListView.ViewScrollAmount;
if NewY < 0 then NewY:=0;
ListView:SetOrigin(0,NewY);
Refreshviews();
end;
end,
_proto: protopicturebutton,
debug: "Up"
};
// After Script for "Up"
thisView := Up;
begin
thisview.icon:=ROM_uparrowbitmap;
end
// View Up is accesible from Main
Down := /* child of Main */
{viewBounds: {left: 226, top: 167, right: 242, bottom: 183},
viewFormat: 1,
buttonPressedScript:
func()
begin
if ListView.ViewOriginY<ListView.ViewMaxY then begin
local NewY:=ListView.ViewOriginY+ListView.ViewScrollAmount;
if NewY > ListView.ViewMaxY then NewY:=ListView.ViewMaxY;
ListView:SetOrigin(0,NewY);
Refreshviews();
end;
end,
_proto: protopicturebutton,
debug: "Down"
};
// After Script for "Down"
thisView := Down;
begin
thisview.icon:=ROM_downarrowbitmap;
end
// View Down is accesible from Main