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.
Clone URLs: https://rocketgit.com/user/iam-git/ArLan ssh://rocketgit@ssh.rocketgit.com/user/iam-git/ArLan git://git.rocketgit.com/user/iam-git/ArLan
trunk
List of commits:
Subject Hash Author Date (UTC)
Ititiate ArLan's repo with existing code a9185eccbb38b32012f4ec9bcf4584d989f15d00 I am 2021-11-13 23:19:40
Commit a9185eccbb38b32012f4ec9bcf4584d989f15d00 - Ititiate ArLan's repo with existing code
Author: I am
Author date (UTC): 2021-11-13 23:19
Committer name: I am
Committer date (UTC): 2021-11-13 23:19
Parent(s):
Signer:
Signing key:
Signing status: N
Tree: 5a4c706e5bbe91b4b3c16c42c8c76a924cb95d40
File Lines added Lines deleted
arlan.pas 861 0
doublelinked.pas 112 0
misc.pas 100 0
File arlan.pas added (mode: 100755) (index 0000000..0978a58)
1 // ArLan: Simple Gopher client for AROS
2 // I am <ger-alex@seznam.cz>
3 //
4 // Can't believe I dived into it
5 // Never (well, almost) programmed anything
6 // nether in Pascal, nor for AROS.
7 //
8 //
9 //
10 // LICENSE: So, this mess can be used under
11 // conditions of any of these licences:
12 // MIT, BSD, WTF
13 //
14 program arlan;
15 {$mode objfpc}{$H+}
16
17
18 uses
19 SysUtils,
20 StrUtils,
21 Classes,
22 //Types,
23 URIParser,
24
25 misc, doublelinked,
26
27 mui,
28 MUIClass.Base,
29 MUIClass.Window,
30 MUIClass.Gadget,
31 MUIClass.Group,
32 MUIClass.Area,
33
34 Exec,
35 //Amigados, mui, muihelper, utility, intuition, AGraphics,
36 MUIClass.Menu,
37 MUIClass.List,
38 //MUIClass.Numeric, MUIClass.PopString, MUIClass.DrawPanel, MUIClass.Image,
39 MUIClass.Dialog;
40
41
42 type
43 { // defined in doublelinked
44 TItem = record
45 ItemType: char;
46 DisplayString: string;
47 Selector: string;
48 HostName: string;
49 Port: UInt16;
50 end; }
51 TItems = array of TItem;
52
53
54 TMyWindow = class(TMUIWindow)
55 public
56 Items: TItems;
57 FixedFont: boolean;
58 MUIView: TMUIListView;
59 //PageSource: string;
60 Bookmarks: TStringList;
61 GopherMap: TStringList;
62 History: TDLinkedList;
63 Txt: TMUIText;
64 MIPageSource: TMUIMenuItem;
65 Edit: TMUIString;
66 SearchEdit: TMUIString;
67 MUIList: TMUIList;
68
69 SearchWindow: TMUIWindow;
70 SearchItem: TItem;
71 MUISearch: TMUIString;
72 //MyListView: TMUIListView;
73
74 // Events
75 procedure BookmarksClick(Sender: TObject);
76 procedure BookmarkItemTrigger(Sender: TObject);
77 procedure BtnClick(Sender: TObject);
78 procedure ShowPageSource(Sender: TObject);
79 //procedure ConfigStart(Sender: TObject);
80 procedure QuitMe(Sender: TObject);
81 procedure EditAck(Sender: TObject);
82 procedure SearchAck(Sender: TObject);
83 procedure VeronicaSearchAck(Sender: TObject);
84 procedure About(Sender: TObject);
85 procedure AboutMUI(Sender: TObject);
86
87 procedure LoadPage(server: string; port: UInt16; selector: string);
88 procedure ShowText(InputText: string; WTitle: string);
89 procedure RequireSearch(Item: TItem);
90 procedure LoadURL(URL: string);
91 procedure LoadItem(activeItem: TItem);
92 function ParseMap(InputText: string): TItems;
93 procedure RenderPage(SourceText: string);
94
95 procedure BackClick(Sender: TObject);
96 procedure ForwardClick(Sender: TObject);
97 procedure ToggleFont(Sender: TObject);
98
99 function ConstructEvent(Sender: TObject; Pool: Pointer; Str: PChar): PChar;
100 procedure DestructEvent(Sender: TObject; Pool: Pointer; Entry: PChar);
101 procedure ListClickEvent(Sender: TObject);
102 procedure ListDoubleClickEvent(Sender: TObject);
103 //procedure FinishedReading(Sender: TObject);
104
105 constructor Create; override;
106 destructor Destroy; override;
107
108 end;
109
110
111
112
113 function ParseLine(InputLine: string): TItem;
114 var
115 strs: array of string;
116 _code: Word;
117 begin
118
119 with Result do
120 begin
121 ItemType := 'q';
122 DisplayString := '';
123 Selector := '';
124 HostName := '';
125 //cz na ten port nasrat
126 end;
127 if not InputLine.IsEmpty then
128 begin
129 Result.ItemType := InputLine[1];
130 strs := SplitString(InputLine.Remove(0,1), #9);
131 if Length(strs) >= 1 then
132 begin
133 Result.DisplayString := strs[0];
134 end;
135 if Length(strs) >= 4 then
136 begin
137 Result.Selector := strs[1];
138 Result.HostName := strs[2];
139 Val(strs[3], Result.Port, _code);
140 end;
141 end;
142 end;
143
144 {
145 function ParseMap(InputText: string): TItems;
146 var
147 str: string;
148 i: word;
149 strList: TStringList;
150 //Items: TItems;
151 begin
152 strList := TStringList.Create;
153 StrList.Text := InputText;
154 SetLength(Result, StrList.Count);
155 i := 0;
156 while i < StrList.Count do
157 begin
158 str := StrList.Strings[i];
159 Result[i] := ParseLine(str);
160 inc(i);
161 end;
162 StrList.Free;
163 //Result := Items;
164 end;
165 }
166
167
168
169
170
171 constructor TMyWindow.Create;
172 var
173 // not neeeded later
174 Men: TMUIMenu;
175 WoMen: TMUIMenu;
176 Pnl: TMUIGroup;
177 MM: TMUIMenuStrip;
178 MML: TMUIMenuStrip;
179 //i: Integer;
180 FirstItem: TItem;
181 begin
182 inherited;
183 Bookmarks := TStringList.Create;
184 try
185 Bookmarks.LoadFromFile('Bookmarks');
186 except
187 end;
188
189
190 GopherMap := TStringList.Create;
191
192 //cz hned na zacatku vytvorime History
193 //cz a je po ptakach
194 with FirstItem do
195 begin
196 ItemType := '1';
197 DisplayString := 'Floodgap';
198 Selector := '';
199 HostName := 'gopher.floodgap.com';
200 Port := 70;
201 end;
202 History := TDLinkedList.Create(FirstItem);
203 //SizeGadget := False; // Disable SizeGadget
204
205 Title := '';
206 ScreenTitle := 'ArLan: simple Gopher client';
207 Height := 600;
208 Width := 500;
209
210 //Horizontal := False;
211
212 Pnl := TMUIGroup.Create;
213 Pnl.Horiz := True;
214 Pnl.Parent := Self;
215
216 with TMUIButton.Create('<-') do
217 begin
218 OnClick := @BackClick;
219 FixWidth := 20;
220 //ShortHelp := 'This is a Button. ;-)';
221 Parent := Pnl;
222 end;
223
224 with TMUIButton.Create('->') do
225 begin
226 OnClick := @ForwardClick;
227 FixWidth := 20;
228 //ShortHelp := 'This is a Button. ;-)';
229 Parent := Pnl;
230 end;
231
232 with TMUIButton.Create('Bookmarks') do
233 begin
234 OnClick := @BookmarksClick;
235 FixWidth := 28;
236 //ShortHelp := 'This is a Button. ;-)';
237 Parent := Pnl;
238 end;
239
240 Edit := TMUIString.Create;
241 with Edit do
242 begin
243 //Secret := True;
244 OnAcknowledge := @EditAck;
245 Format := MUIV_String_Format_Center;
246 Contents := 'gopher://gopher.floodgap.com';
247 Parent := Pnl;
248 end;
249 //cz nefrci, crash
250 //DefaultObject := Edit;
251
252 {
253 with TMUIBalance.Create do
254 begin
255 FixWidth := 8;
256 Parent := Pnl;
257 end;
258 }
259
260 {
261 with TMUIButton.Create('Go') do
262 begin
263 OnClick := @BtnClick;
264 FixWidth := 28;
265 //ShortHelp := 'This is a Button. ;-)';
266 Parent := Pnl;
267 end;
268 }
269
270 With TMUIText.Create do
271 begin
272 Contents := 'Veronica-2 search:';
273 FixWidth := 28;
274 Parent := Pnl;
275 end;
276
277 SearchEdit := TMUIString.Create;
278 with SearchEdit do
279 begin
280 OnAcknowledge := @VeronicaSearchAck;
281 //Format := MUIV_String_Format_Center;
282 //Contents := '';
283 FixWidth := 58;
284 Parent := Pnl;
285 end;
286
287 //TMUIHBar.Create(11).Parent := Self;
288
289
290
291
292
293
294
295 MM := TMUIMenuStrip.Create;
296
297 MUIApp.MenuStrip := MM; // alternative on the application, activate only one!
298 //Menustrip := MM;
299
300 Men := TMUIMenu.Create;
301 Men.Title := 'Menu';
302 Men.Parent := MM;
303
304 {
305 With TMUIMenuItem.Create do
306 begin
307 Title := 'Page source';
308 Parent := Men;
309 OnTrigger := @ShowPageSource;
310 end;
311 }
312 {
313 With TMUIMenuItem.Create do
314 begin
315 Title := 'Font setup...';
316 Parent := Men;
317 //OnTrigger := @FontSetup;
318 end;
319 }
320
321 With TMUIMenuItem.Create do
322 begin
323 Title := 'Toggle fixed font';
324 Parent := Men;
325 OnTrigger := @ToggleFont;
326 end;
327
328 With TMUIMenuItem.Create do
329 begin
330 Title := 'About...';
331 Parent := Men;
332 OnTrigger := @About;
333 end;
334
335 With TMUIMenuItem.Create do
336 begin
337 Title := 'About MUI...';
338 Parent := Men;
339 OnTrigger := @AboutMUI;
340 end;
341
342 with TMUIMenuItem.Create do
343 begin
344 Title := 'Quit';
345 Parent := Men;
346 OnTrigger := @QuitMe;
347 end;
348
349
350 {
351 Pop := TMUIPopList.Create;
352 with Pop do
353 begin
354 LArray := ['hello', 'Hello2', 'Hello3'];
355 StringObj := TMUIString.Create;
356 Button := TMUIPopButton.Create;
357 //Button.FixWidth := 20;
358 Parent := self;
359 end;
360 }
361
362
363 FixedFont := True;
364 MUIList := TMUIList.Create;
365 with MUIList do
366 begin
367 //SourceStrings := ['one', 'two', 'three', 'four', 'five', 'six', 'seven'];
368 //MinLineHeight := 100;
369 Font := MUIV_Font_Fixed;
370 OnConstruct := @ConstructEvent;
371 OnDestruct := @DestructEvent;
372 //OnDisplay := @DisplayEvent;
373 //OnCompare := @CompareEvent;
374 //OnMultiTest := @MultiTestEvent;
375 //OnChange := @ListClickEvent;
376 //OnActiveChange := @ListClickEvent;
377 end;
378
379 MML := TMUIMenuStrip.Create;
380 MUIList.ContextMenu := MML;
381
382 WoMen := TMUIMenu.Create;
383 WoMen.Title := 'Menu';
384 WoMen.Parent := MML;
385 {
386 With TMUIMenuItem.Create do
387 begin
388 Title := 'Toggle fixed font';
389 Parent := WoMen;
390 OnTrigger := @ToggleFont;
391 end;
392 }
393
394
395 With TMUIMenuItem.Create do
396 begin
397 Title := 'Page source...';
398 Parent := WoMen;
399 OnTrigger := @ShowPageSource;
400 end;
401
402 With TMUIMenuItem.Create do
403 begin
404 Title := 'Bookmark item';
405 Parent := WoMen;
406 OnTrigger := @BookmarkItemTrigger;
407 end;
408 {
409 With TMUIMenuItem.Create do
410 begin
411 Title := 'Save to file...';
412 Parent := WoMen;
413 //OnTrigger := @SavePage;
414 end;
415 }
416
417 MUIView := TMUIListView.Create;
418 with MUIView do
419 begin
420 List := MUIList;
421 Parent := Self;
422
423 MultiSelect := MUIV_Listview_MultiSelect_Default;
424 OnClick := @ListClickEvent;
425 OnDoubleClick := @ListDoubleClickEvent;
426 end;
427
428
429
430 Txt := TMUIText.Create;
431 With Txt do
432 begin
433 Contents := '';
434 //HiChar := 'C';
435 SetVMax := True;
436 //Font := MUIV_Font_Fixed;
437 Parent := Self;
438 end;
439
440
441 SearchWindow := TMUIWindow.Create;
442 SearchWindow.Title := 'Gopher search';
443 SearchWIndow.Close;
444
445
446 With TMUIText.Create do
447 begin
448 Contents := 'Enter search line';//Item.DisplayString;
449 //Font := MUIV_Font_Fixed;
450 Parent := SearchWindow;
451 end;
452
453
454 MUISearch := TMUIString.Create;
455 with MUISearch do
456 begin
457 //Secret := True;
458 OnAcknowledge := @SearchAck;
459 //Format := MUIV_String_Format_Center;
460 //Contents := 'Edit me and press enter';
461 Parent := SearchWindow;
462 end;
463
464
465 //RenderPage(Bookmarks.Text);
466 end;
467
468
469 destructor TMyWindow.Destroy;
470 begin
471 //GopherMap.Free;
472 FreeAndNil(Bookmarks);
473 FreeAndNil(GopherMap);
474 FreeAndNil(History);
475 //SearchWindow.Destroy;
476 inherited;
477 end;
478
479 function TMyWindow.ParseMap(InputText: string): TItems;
480 var
481 str: string;
482 i: word;
483 //strList: TStringList;
484 //Items: TItems;
485 begin
486 //strList := TStringList.Create;
487 GopherMap.Text := InputText;
488 SetLength(Result, GopherMap.Count);
489 i := 0;
490 while i < GopherMap.Count do
491 begin
492 str := GopherMap.Strings[i];
493 Result[i] := ParseLine(str);
494 inc(i);
495 end;
496 //StrList.Free;
497 //Result := Items;
498 end;
499
500
501 procedure TMyWindow.BtnClick(Sender: TObject);
502 begin
503 //writeln('button clicked');
504 LoadURL(Edit.Contents);
505 end;
506
507 procedure TMyWindow.BookmarksClick(Sender: TObject);
508 begin
509 RenderPage(Bookmarks.Text);
510 end;
511
512 procedure TMyWindow.LoadPage(server: string; port: UInt16; selector: string);
513 begin
514 RenderPage(Fetch(server, port, selector));
515 end;
516
517
518 procedure TMyWindow.RenderPage(SourceText: string);
519 var
520 dstr: string;
521 i: word;
522 nullstr: PChar;
523 begin
524 //PageSource := Fetch(server, port, selector);
525 Items := ParseMap(SourceText);
526 //writeln('We have got the Items!');
527 MUIList.Quiet := True;
528 MUIList.Clear;
529 i := 0;
530
531 //writeln(Items[0].DisplayString);
532 //writeln('start cyklus');
533 while i < Length(Items) do
534 begin
535 //writeln('we are inside');
536 //writeln(i);
537 dstr := Items[i].DisplayString;
538 // esc 2 - black
539 // esc 3 - white
540 // esc 4 - black
541 // esc 5 - light blue
542 // esc 6 - black
543 // esc 7 - gray
544 // esc 8 - white
545 // esc 9 - black
546 case Items[i].ItemType of
547 'i': ; // just text
548 '0': dstr := #27'u' + dstr + #27'n '; // link to text file: black underlined
549 '1': dstr := #27'5' + #27'u' + dstr + #27'n ';//gopher link: blue underlined
550 '7': dstr := #27'5' + #27'b' + dstr + #27'n ';//gopher search: blue bolded
551 'h': dstr := #27'7' + #27'u' + dstr + #27'n ';//http(s): greyed underlined
552 '2', '3', '8', '+', 'T': dstr := #27'i' + dstr + #27'n ';//telnet etc.. italic
553 else dstr := #27'b' + dstr + #27'n ';// everythink else (typically some files) - black bolded
554 end;
555 nullstr := stralloc(Length(dstr));
556 MUIList.InsertSingle(strpcopy(nullstr, dstr), MUIV_List_Insert_Bottom);
557 inc(i);
558 end;
559 MUIList.Quiet := False;
560 //MUIList.Redraw(MUIV_List_Redraw_All);
561 end;
562
563
564 procedure TMyWindow.ShowText(InputText: string; WTitle: string);
565 var
566 w2: TMUIWindow;
567 begin
568 W2 := TMUIWindow.Create;
569 W2.Title := WTitle;
570 W2.Height := 500;
571 W2.Width := 400;
572
573 with TMUIFloatText.Create do
574 begin
575 //cz zlobi
576 //SkipChars := #1#13;
577 Text := InputText.Replace(#13#10, #10);
578 if FixedFont then
579 Font := MUIV_Font_Fixed
580 else
581 Font := MUIV_Font_Normal;
582 Parent := W2;
583 end;
584 W2.Show;
585 end;
586
587 procedure TMyWindow.RequireSearch(Item: TItem);
588 begin
589 SearchItem := Item;
590 SearchWindow.Show;
591 end;
592
593 procedure TMyWindow.LoadURL(URL: string);
594 var
595 URI : TURI;
596 selector: string;
597 NewItem : TItem;
598 begin
599 Title := URL;
600
601 URI := ParseURI(URL, 'gopher', 70, True);
602 selector := URI.Path + URI.Document;
603 if not URI.Params.IsEmpty then
604 begin
605 selector := selector + '?' + URI.Params;
606 end;
607
608 with NewItem do
609 begin
610 ItemType := '1';
611 DisplayString := URL;
612 Selector := selector;
613 HostName := URI.Host;
614 Port := URI.Port;
615 end;
616 History.Insert(NewItem);
617
618 LoadPage(URI.Host, URI.Port, selector);
619 end;
620
621
622
623 procedure TMyWindow.ToggleFont(Sender: TObject);
624 begin
625 MUIView.InitChange;
626 if FixedFont then
627 begin
628 MUIView.Font := MUIV_Font_Normal;
629 MUIList.Font := MUIV_Font_Normal;
630 FixedFont := False;
631 end
632 else
633 begin
634 MUIView.Font := MUIV_Font_Fixed;
635 MUIList.Font := MUIV_Font_Fixed;
636 FixedFont := True;
637 end;
638
639 MUIView.ExitChange;
640 MUIList.Redraw(MUIV_List_Redraw_All);
641 end;
642
643
644
645 procedure TMyWindow.About(Sender: TObject);
646 var
647 Ret: integer;
648 begin
649 Ret := MessageBox('ArLan', 'Simple Gopher client for AROS'+ #10 +
650 'gopher://smol.pub/iam/arlan' + #10 +
651 'e-mail: ger-alex@seznam.cz', ['Homepage', 'OK, Thanks']);
652 if Ret = 1 then
653 begin
654 Title := 'ArLan homepage';
655 Edit.Contents := 'gopher://smol.pub/iam/arlan';
656 LoadPage('smol.pub', 70, '/iam/arlan');
657 end;
658
659 end;
660
661 procedure TMyWindow.AboutMUI(Sender: TObject);
662 begin
663 MUIApp.AboutMUI(Self);
664 //MUIApp.OpenConfigWindow;
665 end;
666
667
668
669 procedure TMyWindow.QuitMe(Sender: TObject);
670 begin
671 MUIApp.Terminate;
672 end;
673
674
675 procedure TMyWindow.ShowPageSource(Sender: TObject);
676 begin
677 ShowText(GopherMap.Text, Edit.Contents);
678 end;
679
680
681
682
683 procedure TMyWindow.EditAck(Sender: TObject);
684 begin
685 //Txt.Contents := 'Enter pressed in Edit: "' + Edit.Contents + '"';
686 LoadURL(Edit.Contents);
687 end;
688
689 procedure TMyWindow.SearchAck(Sender: TObject);
690 begin
691 Title := MUISearch.Contents;
692 //Edit.Contents := EncodeURI(URL);
693 LoadPage(SearchItem.HostName, SearchItem.Port, SearchItem.Selector + #9 + MUISearch.Contents );
694 end;
695
696 procedure TMyWindow.VeronicaSearchAck(Sender: TObject);
697 begin
698 Title := SearchEdit.Contents;
699 //Edit.Contents := EncodeURI(URL);
700 LoadPage('gopher.floodgap.com', 70, '/v2/vs' + #9 + SearchEdit.Contents );
701 end;
702
703 function TMyWindow.ConstructEvent(Sender: TObject; Pool: Pointer; Str: PChar): PChar;
704 begin
705
706 Result := AllocPooled(Pool, StrLen(Str) + 1);
707 if Assigned(Result) then
708 StrCopy(Result, Str);
709 end;
710
711 procedure TMyWindow.DestructEvent(Sender: TObject; Pool: Pointer; Entry: PChar);
712 begin
713 FreePooled(Pool, Entry, StrLen(Entry) + 1);
714 end;
715
716
717 procedure TMyWindow.ListClickEvent(Sender: TObject);
718 var
719 i: word;
720 begin
721 if MUIList.Active <> MUIV_List_Active_Off then
722 begin
723 i := MUIList.Active;
724 Txt.Contents := GopherMap.Strings[i];
725 end;
726 end;
727
728 procedure TMyWindow.BackClick(Sender: TObject);
729 begin
730 LoadItem(History.MoveBack);
731 end;
732
733 procedure TMyWindow.ListDoubleClickEvent(Sender: TObject);
734 var
735 i: word;
736 activeItem: TItem;
737 begin
738 i := MUIList.Active;
739 activeItem := Items[i];
740 if activeItem.ItemType = '1' then
741 History.Insert(activeItem);
742 LoadItem(activeItem);
743 end;
744
745 procedure TMyWindow.BookmarkItemTrigger(Sender: TObject);
746 var
747 i: word;
748 begin
749 i := MUIList.Active;
750 Bookmarks.add(GopherMap.Strings[i]);
751 try
752 // And write the contents back to disk, replacing the original contents
753 Bookmarks.SaveToFile('Bookmarks');
754
755 except
756 // If there was an error the reason can be found here
757 on E: EInOutError do
758 ShowMessage('File handling error occurred. Reason: ' + E.Message);
759 end;
760
761 end;
762
763 procedure TMyWindow.ForwardClick(Sender: TObject);
764 begin
765 LoadItem(History.MoveForward);
766 end;
767
768
769 procedure TMyWindow.LoadItem(activeItem: TItem);
770 var
771 URL: TURI;
772 it: char;
773 text: string;
774 FD: TFileDialog;
775
776 begin
777 it := activeItem.ItemType;
778 if (it = '1') or (it = '0') then
779 begin
780 with URL do
781 begin
782 Protocol := 'gopher';
783 Username := '';
784 Password := '';
785 Host := activeItem.HostName;
786 Port := activeItem.Port;
787 Path := activeItem.Selector;
788 //cz zbytek nechcu resit
789 Document := '';
790 Params := '';
791 Bookmark := '';
792 HasAuthority := True;
793 end;
794
795 end;
796 case it of
797 '1':
798 begin
799 Title := activeItem.DisplayString;
800 Edit.Contents := EncodeURI(URL);
801 LoadPage(activeItem.HostName, activeItem.Port, activeItem.Selector);
802 end;
803 '0':
804 begin
805 text := Fetch(activeItem.HostName, activeItem.Port, activeItem.Selector);
806 ShowText(text, activeItem.DisplayString + ' (' + EncodeURI(URL) + ')');
807 end;
808 '7': RequireSearch(activeItem);
809 'i', '2', '3', '8', '+', 'T', 'h': ;//cz nic, to nepodporujeme
810 else //cz zbytek hodime do souboru
811 begin
812 text := Fetch(activeItem.HostName, activeItem.Port, activeItem.Selector);
813 FD := TFileDialog.Create;
814 try
815 FD.TitleText := activeItem.DisplayString;
816 //FileDialog.Pattern := '#?.dat';
817 //FileDialog.Directory := 'DH1:Data';
818 if FD.Execute then
819 SaveStringToFile(text, FD.Filename);
820 finally
821 FD.Free;
822 end;// end try
823 end;//end this case
824 end;//end case block
825
826 end;
827
828
829
830
831
832 procedure Startup;
833 begin
834 MUIApp.Base := 'ARLAN';
835 MUIApp.Title := 'ArLan';
836 MUIApp.Version := '$VER: ArLan 0.1 (31.07.2021)';
837 MUIApp.Author := 'Aleksei "I am" Gerasimov';
838 MUIApp.Copyright := 'Alex';
839 MUIApp.Description := 'Simple Gopher client for AROS';
840
841 TMyWindow.Create;
842
843
844 MUIApp.Run;
845 end;
846
847
848
849 begin
850 Startup;
851 end.
852
853
854
855
856
857
858
859
860
861
File doublelinked.pas added (mode: 100755) (index 0000000..6c8ad90)
1 // Simplified DoubleLinkedList of Records
2 // I am <ger-alex@seznam.cz>
3 //
4 // LICENSE: both BSD or MIT
5 //
6 // Have no idea how exactly Pascal
7 // handles AnsiStrings
8 // and if there is any point to
9 // implement DoubleLinkedList
10 // whereas Pascal anyway will run throught
11 // to count references
12 unit doublelinked;
13 {$mode objfpc}{$H+}
14
15 interface
16
17 type
18 // copypasted from arlan.pas
19 TItem = record
20 ItemType: char;
21 DisplayString: string;
22 Selector: string;
23 HostName: string;
24 Port: UInt16;
25 end;
26
27 PNode = ^TNode;
28 TNode = Record
29 Item: TItem;
30 PreviousNodePtr: PNode;
31 NextNodePtr: PNode;
32 End;
33
34 TDLinkedList = class
35 public
36 FirstNodePtr: PNode;
37 CurrentNodePtr: PNode;
38 procedure Insert(const Item: TItem);
39 function MoveBack: TItem;
40 function MoveForward: TItem;
41 constructor Create(const Item: TItem);
42 destructor Destroy;
43 end;
44
45
46
47 implementation
48
49 constructor TDLinkedList.Create(const Item: TItem);
50 begin
51 New(CurrentNodePtr);
52 CurrentNodePtr^.Item := Item;
53 CurrentNodePtr^.PreviousNodePtr := nil;
54 CurrentNodePtr^.NextNodePtr := nil;
55 FirstNodePtr := CurrentNodePtr;
56 end;
57
58 destructor TDLinkedList.Destroy;
59 var
60 NodePtr: PNode;
61 NextPtr: PNode;
62 begin
63 NodePtr := FirstNodePtr;
64 NextPtr := NodePtr^.NextNodePtr;
65 while Assigned(NextPtr) do
66 begin
67 //cz zvladne Pascal se v tom vyznat?
68 //cz Skutecne vynulovat retezce
69 //cz a uvolnit pamet?
70 Dispose(NodePtr);
71 NodePtr := NextPtr;
72 NextPtr := NodePtr^.NextNodePtr;
73 end;
74 Dispose(NodePtr);
75 end;
76
77 procedure TDLinkedList.Insert(const Item: TItem);
78 var
79 NodePtr: PNode;
80 begin
81 New(NodePtr);
82 NodePtr^.Item := Item;
83 NodePtr^.PreviousNodePtr := CurrentNodePtr;
84 NodePtr^.NextNodePtr := CurrentNodePtr^.NextNodePtr;
85 CurrentNodePtr^.NextNodePtr := NodePtr;
86 CurrentNodePtr := NodePtr;
87 NodePtr := CurrentNodePtr^.NextNodePtr;
88 NodePtr^.PreviousNodePtr := CurrentNodePtr;
89 end;
90
91 function TDLinkedList.MoveBack: TItem;
92 var
93 PreviousPtr: PNode;
94 begin
95 PreviousPtr := CurrentNodePtr^.PreviousNodePtr;
96 if Assigned(PreviousPtr) then
97 CurrentNodePtr := PreviousPtr;
98 Result := CurrentNodePtr^.Item
99 end;
100
101 function TDLinkedList.MoveForward: TItem;
102 var
103 NextPtr: PNode;
104 begin
105 NextPtr := CurrentNodePtr^.NextNodePtr;
106 if Assigned(NextPtr) then
107 CurrentNodePtr := CurrentNodePtr^.NextNodePtr;
108 Result := CurrentNodePtr^.Item
109 end;
110
111 end.
112
File misc.pas added (mode: 100755) (index 0000000..9f5f667)
1 // here are placed functions taken from somewhere
2 // They have their own licenses!
3
4 unit misc;
5 {$mode objfpc}{$H+}
6 interface
7 uses
8 Classes, sysutils, MUIClass.Dialog, // for SaveStringToFile
9 ssockets; // for Fetch function
10
11 function SaveStringToFile(theString, filePath: AnsiString): boolean;
12 function Fetch(Addr: string; Port: Integer; What: string): string;
13
14 implementation
15
16 // Source: FreePascal wiki
17 // https://wiki.freepascal.org/File_Handling_In_Pascal
18 // What is license for it?
19 //
20 // SaveStringToFile: function to store a string of text into a diskfile.
21 // If the function result equals true, the string was written ok.
22 // If not then there was some kind of error.
23 function SaveStringToFile(theString, filePath: AnsiString): boolean;
24 var
25 fsOut: TFileStream;
26 begin
27 // By default assume the writing will fail.
28 result := false;
29
30 // Write the given string to a file, catching potential errors in the process.
31 try
32 fsOut := TFileStream.Create(filePath, fmCreate);
33 fsOut.Write(theString[1], length(theString));
34 fsOut.Free;
35
36 // At his point it is known that the writing went ok.
37 result := true
38
39 except
40 on E:Exception do
41 ShowMessage('String could not be written. Details: '+ E.ClassName + ': '+ E.Message);
42 end
43 end;
44
45
46 // Fetch function is taken from "Little Gopher Client"'s code.
47 // http://runtimeterror.com/tools/gopher/
48 // Its license:
49 {
50 Little Gopher Client
51 Copyright (C) 2016 Kostas Michalopoulos
52
53 This software is provided 'as-is', without any express or implied
54 warranty. In no event will the authors be held liable for any damages
55 arising from the use of this software.
56
57 Permission is granted to anyone to use this software for any purpose,
58 including commercial applications, and to alter it and redistribute it
59 freely, subject to the following restrictions:
60
61 1. The origin of this software must not be misrepresented; you must not
62 claim that you wrote the original software. If you use this software
63 in a product, an acknowledgment in the product documentation would be
64 appreciated but is not required.
65 2. Altered source versions must be plainly marked as such, and must not be
66 misrepresented as being the original software.
67 3. This notice may not be removed or altered from any source distribution.
68
69 Kostas Michalopoulos <badsector@runtimeterror.com>
70 }
71 function Fetch(Addr: string; Port: Integer; What: string): string;
72 var
73 Conn: TInetSocket = nil;
74 Buff: array [0..65535] of AnsiChar;
75 Total: array of AnsiChar;
76 Got, AllGot: LongInt;
77 I: Integer;
78 begin
79 try
80 Conn:=TInetSocket.Create(Addr, Port);
81 What := What + #13#10;
82 Conn.Write((@What[1])^, Length(What));
83 AllGot:=0;
84 while True do begin
85 Got:=Conn.Read(Buff, SizeOf(Buff));
86 if Got < 1 then Break;
87 SetLength(Total, Length(Total) + Got);
88 Move((@Buff[0])^, (@Total[AllGot])^, Got);
89 Inc(AllGot, Got);
90 end;
91 SetLength(Result, AllGot);
92 for I:=1 to AllGot do Result[I]:=Total[I - 1];
93 except
94 ShowMessage('Failed to get data: ' + Exception(ExceptObject).Message, 'Fetch error');
95 Result:='';
96 end;
97 FreeAndNil(Conn);
98 end;
99
100 end.
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