// ArLan: Simple Gopher client for AROS
// I am <ger-alex@seznam.cz>
//
// Can't believe I dived into it
// Never (well, almost) programmed anything
// nether in Pascal, nor for AROS.
//
//
//
// LICENSE: So, this mess can be used under
// conditions of any of these licences:
// MIT, BSD, WTF
//
program arlan;
{$mode objfpc}{$H+}
uses
SysUtils,
StrUtils,
Classes,
//Types,
URIParser,
misc, doublelinked,
mui,
MUIClass.Base,
MUIClass.Window,
MUIClass.Gadget,
MUIClass.Group,
MUIClass.Area,
Exec,
//Amigados, mui, muihelper, utility, intuition, AGraphics,
MUIClass.Menu,
MUIClass.List,
//MUIClass.Numeric, MUIClass.PopString, MUIClass.DrawPanel, MUIClass.Image,
MUIClass.Dialog;
type
{ // defined in doublelinked
TItem = record
ItemType: char;
DisplayString: string;
Selector: string;
HostName: string;
Port: UInt16;
end; }
TItems = array of TItem;
TMyWindow = class(TMUIWindow)
public
Items: TItems;
FixedFont: boolean;
MUIView: TMUIListView;
//PageSource: string;
Bookmarks: TStringList;
GopherMap: TStringList;
History: TDLinkedList;
Txt: TMUIText;
MIPageSource: TMUIMenuItem;
Edit: TMUIString;
SearchEdit: TMUIString;
MUIList: TMUIList;
SearchWindow: TMUIWindow;
SearchItem: TItem;
MUISearch: TMUIString;
//MyListView: TMUIListView;
// Events
procedure BookmarksClick(Sender: TObject);
procedure BookmarkItemTrigger(Sender: TObject);
procedure BtnClick(Sender: TObject);
procedure ShowPageSource(Sender: TObject);
//procedure ConfigStart(Sender: TObject);
procedure QuitMe(Sender: TObject);
procedure EditAck(Sender: TObject);
procedure SearchAck(Sender: TObject);
procedure VeronicaSearchAck(Sender: TObject);
procedure About(Sender: TObject);
procedure AboutMUI(Sender: TObject);
procedure LoadPage(server: string; port: UInt16; selector: string);
procedure ShowText(InputText: string; WTitle: string);
procedure RequireSearch(Item: TItem);
procedure LoadURL(URL: string);
procedure LoadItem(activeItem: TItem);
function ParseMap(InputText: string): TItems;
procedure RenderPage(SourceText: string);
procedure BackClick(Sender: TObject);
procedure ForwardClick(Sender: TObject);
procedure ToggleFont(Sender: TObject);
function ConstructEvent(Sender: TObject; Pool: Pointer; Str: PChar): PChar;
procedure DestructEvent(Sender: TObject; Pool: Pointer; Entry: PChar);
procedure ListClickEvent(Sender: TObject);
procedure ListDoubleClickEvent(Sender: TObject);
//procedure FinishedReading(Sender: TObject);
constructor Create; override;
destructor Destroy; override;
end;
function ParseLine(InputLine: string): TItem;
var
strs: array of string;
_code: Word;
begin
with Result do
begin
ItemType := 'q';
DisplayString := '';
Selector := '';
HostName := '';
//cz na ten port nasrat
end;
if not InputLine.IsEmpty then
begin
Result.ItemType := InputLine[1];
strs := SplitString(InputLine.Remove(0,1), #9);
if Length(strs) >= 1 then
begin
Result.DisplayString := strs[0];
end;
if Length(strs) >= 4 then
begin
Result.Selector := strs[1];
Result.HostName := strs[2];
Val(strs[3], Result.Port, _code);
end;
end;
end;
{
function ParseMap(InputText: string): TItems;
var
str: string;
i: word;
strList: TStringList;
//Items: TItems;
begin
strList := TStringList.Create;
StrList.Text := InputText;
SetLength(Result, StrList.Count);
i := 0;
while i < StrList.Count do
begin
str := StrList.Strings[i];
Result[i] := ParseLine(str);
inc(i);
end;
StrList.Free;
//Result := Items;
end;
}
constructor TMyWindow.Create;
var
// not neeeded later
Men: TMUIMenu;
WoMen: TMUIMenu;
Pnl: TMUIGroup;
MM: TMUIMenuStrip;
MML: TMUIMenuStrip;
//i: Integer;
FirstItem: TItem;
begin
inherited;
Bookmarks := TStringList.Create;
try
Bookmarks.LoadFromFile('Bookmarks');
except
end;
GopherMap := TStringList.Create;
//cz hned na zacatku vytvorime History
//cz a je po ptakach
with FirstItem do
begin
ItemType := '1';
DisplayString := 'Floodgap';
Selector := '';
HostName := 'gopher.floodgap.com';
Port := 70;
end;
History := TDLinkedList.Create(FirstItem);
//SizeGadget := False; // Disable SizeGadget
Title := '';
ScreenTitle := 'ArLan: simple Gopher client';
Height := 600;
Width := 500;
//Horizontal := False;
Pnl := TMUIGroup.Create;
Pnl.Horiz := True;
Pnl.Parent := Self;
with TMUIButton.Create('<-') do
begin
OnClick := @BackClick;
FixWidth := 20;
//ShortHelp := 'This is a Button. ;-)';
Parent := Pnl;
end;
with TMUIButton.Create('->') do
begin
OnClick := @ForwardClick;
FixWidth := 20;
//ShortHelp := 'This is a Button. ;-)';
Parent := Pnl;
end;
with TMUIButton.Create('Bookmarks') do
begin
OnClick := @BookmarksClick;
FixWidth := 28;
//ShortHelp := 'This is a Button. ;-)';
Parent := Pnl;
end;
Edit := TMUIString.Create;
with Edit do
begin
//Secret := True;
OnAcknowledge := @EditAck;
Format := MUIV_String_Format_Center;
Contents := 'gopher://gopher.floodgap.com';
Parent := Pnl;
end;
//cz nefrci, crash
//DefaultObject := Edit;
{
with TMUIBalance.Create do
begin
FixWidth := 8;
Parent := Pnl;
end;
}
{
with TMUIButton.Create('Go') do
begin
OnClick := @BtnClick;
FixWidth := 28;
//ShortHelp := 'This is a Button. ;-)';
Parent := Pnl;
end;
}
With TMUIText.Create do
begin
Contents := 'Veronica-2 search:';
FixWidth := 28;
Parent := Pnl;
end;
SearchEdit := TMUIString.Create;
with SearchEdit do
begin
OnAcknowledge := @VeronicaSearchAck;
//Format := MUIV_String_Format_Center;
//Contents := '';
FixWidth := 58;
Parent := Pnl;
end;
//TMUIHBar.Create(11).Parent := Self;
MM := TMUIMenuStrip.Create;
MUIApp.MenuStrip := MM; // alternative on the application, activate only one!
//Menustrip := MM;
Men := TMUIMenu.Create;
Men.Title := 'Menu';
Men.Parent := MM;
{
With TMUIMenuItem.Create do
begin
Title := 'Page source';
Parent := Men;
OnTrigger := @ShowPageSource;
end;
}
{
With TMUIMenuItem.Create do
begin
Title := 'Font setup...';
Parent := Men;
//OnTrigger := @FontSetup;
end;
}
With TMUIMenuItem.Create do
begin
Title := 'Toggle fixed font';
Parent := Men;
OnTrigger := @ToggleFont;
end;
With TMUIMenuItem.Create do
begin
Title := 'About...';
Parent := Men;
OnTrigger := @About;
end;
With TMUIMenuItem.Create do
begin
Title := 'About MUI...';
Parent := Men;
OnTrigger := @AboutMUI;
end;
with TMUIMenuItem.Create do
begin
Title := 'Quit';
Parent := Men;
OnTrigger := @QuitMe;
end;
{
Pop := TMUIPopList.Create;
with Pop do
begin
LArray := ['hello', 'Hello2', 'Hello3'];
StringObj := TMUIString.Create;
Button := TMUIPopButton.Create;
//Button.FixWidth := 20;
Parent := self;
end;
}
FixedFont := True;
MUIList := TMUIList.Create;
with MUIList do
begin
//SourceStrings := ['one', 'two', 'three', 'four', 'five', 'six', 'seven'];
//MinLineHeight := 100;
Font := MUIV_Font_Fixed;
OnConstruct := @ConstructEvent;
OnDestruct := @DestructEvent;
//OnDisplay := @DisplayEvent;
//OnCompare := @CompareEvent;
//OnMultiTest := @MultiTestEvent;
//OnChange := @ListClickEvent;
//OnActiveChange := @ListClickEvent;
end;
MML := TMUIMenuStrip.Create;
MUIList.ContextMenu := MML;
WoMen := TMUIMenu.Create;
WoMen.Title := 'Menu';
WoMen.Parent := MML;
{
With TMUIMenuItem.Create do
begin
Title := 'Toggle fixed font';
Parent := WoMen;
OnTrigger := @ToggleFont;
end;
}
With TMUIMenuItem.Create do
begin
Title := 'Page source...';
Parent := WoMen;
OnTrigger := @ShowPageSource;
end;
With TMUIMenuItem.Create do
begin
Title := 'Bookmark item';
Parent := WoMen;
OnTrigger := @BookmarkItemTrigger;
end;
{
With TMUIMenuItem.Create do
begin
Title := 'Save to file...';
Parent := WoMen;
//OnTrigger := @SavePage;
end;
}
MUIView := TMUIListView.Create;
with MUIView do
begin
List := MUIList;
Parent := Self;
MultiSelect := MUIV_Listview_MultiSelect_Default;
OnClick := @ListClickEvent;
OnDoubleClick := @ListDoubleClickEvent;
end;
Txt := TMUIText.Create;
With Txt do
begin
Contents := '';
//HiChar := 'C';
SetVMax := True;
//Font := MUIV_Font_Fixed;
Parent := Self;
end;
SearchWindow := TMUIWindow.Create;
SearchWindow.Title := 'Gopher search';
SearchWIndow.Close;
With TMUIText.Create do
begin
Contents := 'Enter search line';//Item.DisplayString;
//Font := MUIV_Font_Fixed;
Parent := SearchWindow;
end;
MUISearch := TMUIString.Create;
with MUISearch do
begin
//Secret := True;
OnAcknowledge := @SearchAck;
//Format := MUIV_String_Format_Center;
//Contents := 'Edit me and press enter';
Parent := SearchWindow;
end;
//RenderPage(Bookmarks.Text);
end;
destructor TMyWindow.Destroy;
begin
//GopherMap.Free;
FreeAndNil(Bookmarks);
FreeAndNil(GopherMap);
FreeAndNil(History);
//SearchWindow.Destroy;
inherited;
end;
function TMyWindow.ParseMap(InputText: string): TItems;
var
str: string;
i: word;
//strList: TStringList;
//Items: TItems;
begin
//strList := TStringList.Create;
GopherMap.Text := InputText;
SetLength(Result, GopherMap.Count);
i := 0;
while i < GopherMap.Count do
begin
str := GopherMap.Strings[i];
Result[i] := ParseLine(str);
inc(i);
end;
//StrList.Free;
//Result := Items;
end;
procedure TMyWindow.BtnClick(Sender: TObject);
begin
//writeln('button clicked');
LoadURL(Edit.Contents);
end;
procedure TMyWindow.BookmarksClick(Sender: TObject);
begin
RenderPage(Bookmarks.Text);
end;
procedure TMyWindow.LoadPage(server: string; port: UInt16; selector: string);
begin
RenderPage(Fetch(server, port, selector));
end;
procedure TMyWindow.RenderPage(SourceText: string);
var
dstr: string;
i: word;
nullstr: PChar;
begin
//PageSource := Fetch(server, port, selector);
Items := ParseMap(SourceText);
//writeln('We have got the Items!');
MUIList.Quiet := True;
MUIList.Clear;
i := 0;
//writeln(Items[0].DisplayString);
//writeln('start cyklus');
while i < Length(Items) do
begin
//writeln('we are inside');
//writeln(i);
dstr := Items[i].DisplayString;
// esc 2 - black
// esc 3 - white
// esc 4 - black
// esc 5 - light blue
// esc 6 - black
// esc 7 - gray
// esc 8 - white
// esc 9 - black
case Items[i].ItemType of
'i': ; // just text
'0': dstr := #27'u' + dstr + #27'n '; // link to text file: black underlined
'1': dstr := #27'5' + #27'u' + dstr + #27'n ';//gopher link: blue underlined
'7': dstr := #27'5' + #27'b' + dstr + #27'n ';//gopher search: blue bolded
'h': dstr := #27'7' + #27'u' + dstr + #27'n ';//http(s): greyed underlined
'2', '3', '8', '+', 'T': dstr := #27'i' + dstr + #27'n ';//telnet etc.. italic
else dstr := #27'b' + dstr + #27'n ';// everythink else (typically some files) - black bolded
end;
nullstr := stralloc(Length(dstr));
MUIList.InsertSingle(strpcopy(nullstr, dstr), MUIV_List_Insert_Bottom);
inc(i);
end;
MUIList.Quiet := False;
//MUIList.Redraw(MUIV_List_Redraw_All);
end;
procedure TMyWindow.ShowText(InputText: string; WTitle: string);
var
w2: TMUIWindow;
begin
W2 := TMUIWindow.Create;
W2.Title := WTitle;
W2.Height := 500;
W2.Width := 400;
with TMUIFloatText.Create do
begin
//cz zlobi
//SkipChars := #1#13;
Text := InputText.Replace(#13#10, #10);
if FixedFont then
Font := MUIV_Font_Fixed
else
Font := MUIV_Font_Normal;
Parent := W2;
end;
W2.Show;
end;
procedure TMyWindow.RequireSearch(Item: TItem);
begin
SearchItem := Item;
SearchWindow.Show;
end;
procedure TMyWindow.LoadURL(URL: string);
var
URI : TURI;
selector: string;
NewItem : TItem;
begin
Title := URL;
URI := ParseURI(URL, 'gopher', 70, True);
selector := URI.Path + URI.Document;
if not URI.Params.IsEmpty then
begin
selector := selector + '?' + URI.Params;
end;
with NewItem do
begin
ItemType := '1';
DisplayString := URL;
Selector := selector;
HostName := URI.Host;
Port := URI.Port;
end;
History.Insert(NewItem);
LoadPage(URI.Host, URI.Port, selector);
end;
procedure TMyWindow.ToggleFont(Sender: TObject);
begin
MUIView.InitChange;
if FixedFont then
begin
MUIView.Font := MUIV_Font_Normal;
MUIList.Font := MUIV_Font_Normal;
FixedFont := False;
end
else
begin
MUIView.Font := MUIV_Font_Fixed;
MUIList.Font := MUIV_Font_Fixed;
FixedFont := True;
end;
MUIView.ExitChange;
MUIList.Redraw(MUIV_List_Redraw_All);
end;
procedure TMyWindow.About(Sender: TObject);
var
Ret: integer;
begin
Ret := MessageBox('ArLan', 'Simple Gopher client for AROS'+ #10 +
'gopher://smol.pub/iam/arlan' + #10 +
'e-mail: ger-alex@seznam.cz', ['Homepage', 'OK, Thanks']);
if Ret = 1 then
begin
Title := 'ArLan homepage';
Edit.Contents := 'gopher://smol.pub/iam/arlan';
LoadPage('smol.pub', 70, '/iam/arlan');
end;
end;
procedure TMyWindow.AboutMUI(Sender: TObject);
begin
MUIApp.AboutMUI(Self);
//MUIApp.OpenConfigWindow;
end;
procedure TMyWindow.QuitMe(Sender: TObject);
begin
MUIApp.Terminate;
end;
procedure TMyWindow.ShowPageSource(Sender: TObject);
begin
ShowText(GopherMap.Text, Edit.Contents);
end;
procedure TMyWindow.EditAck(Sender: TObject);
begin
//Txt.Contents := 'Enter pressed in Edit: "' + Edit.Contents + '"';
LoadURL(Edit.Contents);
end;
procedure TMyWindow.SearchAck(Sender: TObject);
begin
Title := MUISearch.Contents;
//Edit.Contents := EncodeURI(URL);
LoadPage(SearchItem.HostName, SearchItem.Port, SearchItem.Selector + #9 + MUISearch.Contents );
end;
procedure TMyWindow.VeronicaSearchAck(Sender: TObject);
begin
Title := SearchEdit.Contents;
//Edit.Contents := EncodeURI(URL);
LoadPage('gopher.floodgap.com', 70, '/v2/vs' + #9 + SearchEdit.Contents );
end;
function TMyWindow.ConstructEvent(Sender: TObject; Pool: Pointer; Str: PChar): PChar;
begin
Result := AllocPooled(Pool, StrLen(Str) + 1);
if Assigned(Result) then
StrCopy(Result, Str);
end;
procedure TMyWindow.DestructEvent(Sender: TObject; Pool: Pointer; Entry: PChar);
begin
FreePooled(Pool, Entry, StrLen(Entry) + 1);
end;
procedure TMyWindow.ListClickEvent(Sender: TObject);
var
i: word;
begin
if MUIList.Active <> MUIV_List_Active_Off then
begin
i := MUIList.Active;
Txt.Contents := GopherMap.Strings[i];
end;
end;
procedure TMyWindow.BackClick(Sender: TObject);
begin
LoadItem(History.MoveBack);
end;
procedure TMyWindow.ListDoubleClickEvent(Sender: TObject);
var
i: word;
activeItem: TItem;
begin
i := MUIList.Active;
activeItem := Items[i];
if activeItem.ItemType = '1' then
History.Insert(activeItem);
LoadItem(activeItem);
end;
procedure TMyWindow.BookmarkItemTrigger(Sender: TObject);
var
i: word;
begin
i := MUIList.Active;
Bookmarks.add(GopherMap.Strings[i]);
try
// And write the contents back to disk, replacing the original contents
Bookmarks.SaveToFile('Bookmarks');
except
// If there was an error the reason can be found here
on E: EInOutError do
ShowMessage('File handling error occurred. Reason: ' + E.Message);
end;
end;
procedure TMyWindow.ForwardClick(Sender: TObject);
begin
LoadItem(History.MoveForward);
end;
procedure TMyWindow.LoadItem(activeItem: TItem);
var
URL: TURI;
it: char;
text: string;
FD: TFileDialog;
begin
it := activeItem.ItemType;
if (it = '1') or (it = '0') then
begin
with URL do
begin
Protocol := 'gopher';
Username := '';
Password := '';
Host := activeItem.HostName;
Port := activeItem.Port;
Path := activeItem.Selector;
//cz zbytek nechcu resit
Document := '';
Params := '';
Bookmark := '';
HasAuthority := True;
end;
end;
case it of
'1':
begin
Title := activeItem.DisplayString;
Edit.Contents := EncodeURI(URL);
LoadPage(activeItem.HostName, activeItem.Port, activeItem.Selector);
end;
'0':
begin
text := Fetch(activeItem.HostName, activeItem.Port, activeItem.Selector);
ShowText(text, activeItem.DisplayString + ' (' + EncodeURI(URL) + ')');
end;
'7': RequireSearch(activeItem);
'i', '2', '3', '8', '+', 'T', 'h': ;//cz nic, to nepodporujeme
else //cz zbytek hodime do souboru
begin
text := Fetch(activeItem.HostName, activeItem.Port, activeItem.Selector);
FD := TFileDialog.Create;
try
FD.TitleText := activeItem.DisplayString;
//FileDialog.Pattern := '#?.dat';
//FileDialog.Directory := 'DH1:Data';
if FD.Execute then
SaveStringToFile(text, FD.Filename);
finally
FD.Free;
end;// end try
end;//end this case
end;//end case block
end;
procedure Startup;
begin
MUIApp.Base := 'ARLAN';
MUIApp.Title := 'ArLan';
MUIApp.Version := '$VER: ArLan 0.1 (31.07.2021)';
MUIApp.Author := 'Aleksei "I am" Gerasimov';
MUIApp.Copyright := 'Alex';
MUIApp.Description := 'Simple Gopher client for AROS';
TMyWindow.Create;
MUIApp.Run;
end;
begin
Startup;
end.