iam-git / ArLan (public) (License: MIT) (since 2021-11-13) (hash sha1)
ArLan is an gopher client for Amiga flavour OSes (originally for AROS). Written in freepascal.

/arlan.pas (0978a58982f582f25a7ecf07180e5e291bc5f8e3) (17800 bytes) (mode 100755) (type blob)

// 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.












Mode Type Size Ref File
100755 blob 541 4b340345c4ae30c28b68b5d45dd255e6c6531ed2 ReadMe
100755 blob 17800 0978a58982f582f25a7ecf07180e5e291bc5f8e3 arlan.pas
100755 blob 2379 6c8ad90e7583d80c442f3e6d2abbfeeba6ce016a doublelinked.pas
100755 blob 3123 9f5f66755008c22abc8d9d706be723bed977474b misc.pas
Hints:
Before first commit, do not forget to setup your git environment:
git config --global user.name "your_name_here"
git config --global user.email "your@email_here"

Clone this repository using HTTP(S):
git clone https://rocketgit.com/user/iam-git/ArLan

Clone this repository using ssh (do not forget to upload a key first):
git clone ssh://rocketgit@ssh.rocketgit.com/user/iam-git/ArLan

Clone this repository using git:
git clone git://git.rocketgit.com/user/iam-git/ArLan

You are allowed to anonymously push to this repository.
This means that your pushed commits will automatically be transformed into a merge request:
... clone the repository ...
... make some changes and some commits ...
git push origin main