* Amiga includes (from 0.99.5 release)

packages/extra/amunits/README

@@ -0,0 +1,160 @@
+
+Readme for the m68k compiler FPC 0.99.5c
+----------------------------------------
+
+Updated since last version:
+  - alignment problems bugfixed -- now it works for real (I hope!)
+  - CRC loading on big endian machines was wrong
+
+1) m68k binaries
+2) Cross-compiler binaries
+3) General information and porting tips
+
+1) m68k Binaries information
+----------------------------
+
+  Amiga binary version notes:
+  ---------------------------
+
+  Requirements:
+    - 2 Megabytes RAM (Chip or Fast) minimum to produce assembler files
+    - 1 Megabyte hard drive space
+    - 128K stack space (set it via 'stack')
+    - AmigaOS v2.04 or higher
+
+  Further information:
+    - Because the heap can become fragmented when using ld and as, sometimes
+      you will no longer be able to run ppc after calling these programs,
+      use avail flush or reboot your computer to solve this.
+    - Because how the os works with files and because of a bug in the
+      compiler, if an error occurs or a break signal is issued. some files
+      might remain opened. This only happens with non units and non source
+      code files such as ppc.cfg, the only way to fix this is to reboot
+      the computer. As soon as i have the time, I will implement an exit
+      procedure in the system unit which close all files automatically on
+      any program termination.
+    - gdb support is not implemented, as it requires an interface
+      to ixemul.library
+    - as 2.5.2 and ld 2.8.1 are used in this package, since as 2.8.1 seems
+      to be buggy (at least the version i downloaded) with gdb info
+    - A good debugging tool to use is barfly available from Aminet
+
+  Atari binary version notes:
+  ---------------------------
+
+  Requirements:
+    - 2 Megabytes RAM minimum to produce assembler files
+    - 1 Megabyte hard drive space
+    - GemDOS 0.15 or higher
+    - Atari Extended Argument Specification compatible shell
+
+
+2) Cross-compiler binaries
+--------------------------
+
+   PC/MS-DOS version
+   ------------------
+    - 2 Megabytes RAM minimum to produce assembler files
+    - 1 Megabyte hard drive space
+    - DOS 3.3 and higher
+    - 16-bit dpmi server (one is supplied with the binary)
+
+    A default configuration can be found in ppc.cfg, and the
+    sysatari library source code is in the ./src/ directory.
+
+    This can be used as a template for embedded processor
+    development, you just need to replace all sysatari
+    routines by emtpy ones (for example), most other routines
+    in the include file should be kept (some of them are internal)
+
+   PC/Linux version
+   -----------------
+    - 2 Megabytes RAM minimum to produce Amiga binaries
+    - 2 Megabyte hard drive space with all binaries,
+      compiler, assembler and linker + rtl.
+
+    - amigaas, gnu as, a crossversion, included
+    - amigald, gnu ld, a crossversion, included
+
+    The compiler will read pp68k.cfg for configuration the
+    proper place for this is in /etc. A default pp68k.cfg is
+    in /bin/.
+
+    Just make sure that pp68k, amigaas and amigald is in
+    your path, why not /usr/local/bin
+
+3) General information and porting tips
+---------------------------------------
+
+  - Alignment output is supposedely correct even though i can't
+    personally test this. (Someone else tested for me)
+  - Some tips to port some general code from i386 FPC to m68k FPC,
+    you should limit your local variables and pushed variables
+    in a routine 32K, this is a displacement limit of older m68k
+    processors, and it has been kept.
+  - If you use PACKED records anywhere, make sure that non-byte fields
+    are aligned on even addresses, otherwise this will cause
+    alignment errors on older m68k processors (68000/68010), if
+    you don't use packed , disregard this remark, as everything
+    will be automatically aligned. The compiler takes care of
+    of aligning all local and global simple type variables on
+    at least word boundaries (for the m68k only). pointer are always
+    at least aligned on dword boundaries.
+  - PPU files (PP? files) are portable across big-endian and little
+    endian systems, EXCEPT in the case where the unit references
+    floating point values, as these are not saved in the correct
+    endian for the moment.
+  - GNU assembler (gas) syntax acceptance varies widely between gas versions
+    ,therefore the -Ai and -Agas switches are your friend here. If you
+    still get trouble try, -TPALMOS as a target, this changes to more
+    standard assembler. Finally in any case you can always the
+    --register-prefix-optional options in any GNU assembler version if it
+    still does not work.
+  - To compile a system unit use these switches:
+      TARGET -dm68k -Sg -Us mysystem.pp
+          where TARGET can be:
+            -TAMIGA, -TATARI , -TLINUX or -TPALMOS
+            mysystem.pp should be replaced by the system unit name
+            for the platform:
+             amiga: sysamiga.pas
+             atari: sysatari.pas
+             linux: syslinux.pp
+             palmos: syspalm.pp
+  - BIG sets (with more then different 32 values) are stored in little
+    endian format. This can cause BIG problems if you use exotic set
+    functions like an array of byte typecast to a set, the values should
+    be byteswapped first to conform to little (intel) endian format. If
+    you use normal set functions such as addition, subtraction, in operator
+    you should not get any problems. I'm not sure if this is worth fixing
+    or not :(...
+  - Because of how everything works now, BYTE pushes are stored in byte
+    reversed format in a word on the stack. This behavior should not
+    be noticeable unless you do very low level stuff. The downside of this
+    is that linking with external routines which expect bytes as parameters
+    will probably not work. This will be fixed, just need to find the
+    time to do it.
+
+Enjoy! BTW: I still need help in porting to Mac, Linux and Atari and
+also someone to do a peephole optimizer for the m68k code output.
+
+You can get general Free Pascal information at:
+ http://www.brain.uni-freibrug.de/~klaus/fpc/fpc.html
+Developer mailing list:
+ [email protected]
+
+You can contact me at:
+ [email protected]
+ http://www-edu.gel.usherb.ca/codc01
+Amiga inlucdes/units and Amiga specific stuff:
+ [email protected]
+
+Thanks:
+  That is apart from the FPC development team (which i am part)....:
+
+    Nils Sjoholm - AMIGA porter and tester, 68000 tester,
+      the most dedicated person for the m68k port found so far!
+
+                                    Enjoy!
+                                    Carl Eric Codere
+
+

packages/extra/amunits/demos/asltest.pas

@@ -0,0 +1,33 @@
+PROGRAM AslTest;
+
+uses Exec, Utility, Asl;
+
+{$I tagutils.inc}
+
+VAR
+    fr    : pFileRequester;
+    dummy : BOOLEAN;
+    thetags : array [0..3] of tTagItem;
+BEGIN
+    AslBase := OpenLibrary(AslName,37);
+    IF AslBase <> NIL THEN BEGIN
+       thetags[0] := TagItem(ASLFR_InitialPattern,Longint(PChar('#?'#0)));
+       thetags[1] := TagItem(ASLFR_TitleText,Longint(PChar('Test av ASL-Requester by NS'#0)));
+       thetags[2] := TagItem(ASLFR_DoPatterns,1);
+       thetags[3].ti_Tag := TAG_DONE;
+
+       fr := AllocAslRequest(ASL_FileRequest,@thetags);
+       IF fr <> nil THEN BEGIN
+           dummy := AslRequest(fr,NIL);
+           if dummy then begin
+              writeln('The path is     :',fr^.rf_Dir);
+              writeln('And the file is :',fr^.rf_File);
+           end else writeln('You canceled');
+           FreeAslRequest(fr);
+       END;
+    CloseLibrary(AslBase);
+    END else writeln('no asl.library');
+END.
+
+
+

packages/extra/amunits/demos/bezier.pas

@@ -0,0 +1,253 @@
+Program Bezier;
+
+{
+   This program draws Bezier curves using the degree elevation
+   method.  For large numbers of points (more than 10, for
+   example) this is faster than the recursive way.
+}
+
+{
+   Changed the source to use 2.0+.
+   Looks a lot better.
+   Added CloseWindowSafely.
+   Made the window dynamic, it will
+   adjust the size after the screen size.
+   9 May 1998.
+
+   Translated the source to fpc.
+   20 Aug 1998.
+
+   [email protected]
+}
+
+uses exec, intuition, graphics, utility;
+
+{$I tagutils.inc}
+
+type
+    PointRec = packed Record
+        X, Y : Real;
+    end;
+
+Const
+    w  : pWindow  = Nil;
+    s  : pScreen   = Nil;
+    ltrue : longint = 1;
+{
+    This will make the new look for screen.
+    SA_Pens, Integer(pens)
+}
+    pens : array [0..0] of integer = (not 0);
+
+Var
+    m  : pMessage;
+    rp : pRastPort;
+
+    PointCount : Word;
+    Points : Array [1..200] of PointRec;
+
+    t, tprime : Real;
+
+    LastX, LastY : Word;
+    tags : array[0..13] of tTagItem;
+
+Procedure CleanUpAndDie;
+begin
+    if w <> Nil then CloseWindow(w);
+    if s <> Nil then CloseScreen(s);
+    if Gfxbase <> nil then CloseLibrary(GfxBase);
+    Halt(0);
+end;
+
+Procedure DrawLine;
+begin
+    Move(rp, Trunc(Points[PointCount].X), Trunc(Points[PointCount].Y));
+    Draw(rp, LastX, LastY);
+end;
+
+Procedure GetPoints;
+var
+    LastSeconds,
+    LastMicros  : Longint;
+    IM : pIntuiMessage;
+    StoreMsg : tIntuiMessage;
+    Leave : Boolean;
+    OutOfBounds : Boolean;
+    BorderLeft, BorderRight,
+    BorderTop, BorderBottom : Word;
+    dummy : Boolean;
+
+    Procedure AddPoint;
+    begin
+    Inc(PointCount);
+    with Points[PointCount] do begin
+        X := Real(StoreMsg.MouseX);
+        Y := Real(StoreMsg.MouseY);
+    end;
+    with StoreMsg do begin
+        LastX := MouseX;
+        LastY := MouseY;
+        LastSeconds := Seconds;
+        LastMicros := Micros;
+    end;
+    SetAPen(rp, 2);
+    SetDrMd(rp, JAM1);
+    DrawEllipse(rp, LastX, LastY, 5, 3);
+    SetAPen(rp, 3);
+    SetDrMd(rp, COMPLEMENT);
+    DrawLine;
+    end;
+
+    Function CheckForExit : Boolean;
+    {   This function determines whether the user wanted to stop
+    entering points.  I added the position tests because my
+    doubleclick time is too long, and I was too lazy to dig
+    out Preferences to change it. }
+    begin
+    with StoreMsg do
+        CheckForExit := DoubleClick(LastSeconds, LastMicros,
+                    Seconds, Micros) and
+                (Abs(MouseX - Trunc(Points[PointCount].X)) < 5) and
+                (Abs(MouseY - TRunc(Points[PointCount].Y)) < 3);
+    end;
+
+    Procedure ClearIt;
+    {  This just clears the screen when you enter your first point }
+    begin
+    SetDrMd(rp, JAM1);
+    SetAPen(rp, 0);
+    RectFill(rp, BorderLeft, BorderTop,
+             BorderRight, BorderBottom);
+    SetDrMd(rp, COMPLEMENT);
+    SetAPen(rp, 3);
+    end;
+
+begin
+    dummy := ModifyIDCMP(w, IDCMP_CLOSEWINDOW or IDCMP_MOUSEBUTTONS or IDCMP_MOUSEMOVE);
+    SetDrMd(rp, COMPLEMENT);
+    PointCount := 0;
+    Leave := False;
+    OutOfBounds := False;
+    BorderLeft := w^.BorderLeft;
+    BorderRight := (w^.Width - w^.BorderRight) -1;
+    BorderTop := w^.BorderTop;
+    BorderBottom := (w^.Height - w^.BorderBottom) -1;
+    repeat
+        IM := pIntuiMessage(WaitPort(w^.UserPort));
+        IM := pIntuiMessage(GetMsg(w^.UserPort));
+        StoreMsg := IM^;
+        ReplyMsg(pMessage(IM));
+        case StoreMsg.IClass of
+           IDCMP_MOUSEMOVE : if PointCount > 0 then begin
+                 if not OutOfBounds then
+                 DrawLine;
+                     LastX := StoreMsg.MouseX;
+                     LastY := StoreMsg.MouseY;
+                 if (LastX > BorderLeft) and
+                (LastX < BorderRight) and
+                (LastY > BorderTop) and
+                (LastY < BorderBottom) then begin
+                 DrawLine;
+                 OutOfBounds := False;
+                 end else
+                 OutOfBounds := True;
+                 end;
+           IDCMP_MOUSEBUTTONS : if StoreMsg.Code = SELECTUP then begin
+                    if PointCount > 0 then
+                    Leave := CheckForExit
+                else
+                    ClearIt;
+                    if (not Leave) and (not OutOfBounds) then
+                    AddPoint;
+                    end;
+           IDCMP_CLOSEWINDOW : CleanUpAndDie;
+        end;
+    until Leave or (PointCount > 50);
+    if not Leave then
+        DrawLine;
+    dummy := ModifyIDCMP(w, IDCMP_CLOSEWINDOW);
+    SetDrMd(rp, JAM1);
+    SetAPen(rp, 1);
+end;
+
+Procedure Elevate;
+var
+    t, tprime,
+    RealPoints : Real;
+    i : Integer;
+begin
+    Inc(PointCount);
+    RealPoints := Real(PointCount);
+    Points[PointCount] := Points[Pred(PointCount)];
+    for i := Pred(PointCount) downto 2 do
+    with Points[i] do begin
+        t := Real(i) / RealPoints;
+        tprime := 1.0 - t;
+        X := t * Points[Pred(i)].X + tprime * X;
+        Y := t * Points[Pred(i)].Y + tprime * Y;
+    end;
+end;
+
+Procedure DrawCurve;
+var
+    i : Integer;
+begin
+    Move(rp, Trunc(Points[1].X), Trunc(Points[1].Y));
+    for i := 2 to PointCount do
+    Draw(rp, Round(Points[i].X), Round(Points[i].Y));
+end;
+
+Procedure DrawBezier;
+var
+    i : Word;
+begin
+    SetAPen(rp, 2);
+    while PointCount < 100 do begin
+    Elevate;
+    DrawCurve;
+    if GetMsg(w^.UserPort) <> Nil then
+        CleanUpAndDie;
+    end;
+    SetAPen(rp, 1);
+    DrawCurve;
+end;
+
+begin
+   GfxBase := OpenLibrary(GRAPHICSNAME,37);
+
+                       tags[0] := TagItem(SA_Pens,      Long(@pens));
+                       tags[1] := TagItem(SA_Depth,     2);
+                       tags[2] := TagItem(SA_DisplayID, HIRES_KEY);
+                       tags[3] := TagItem(SA_Title,     Long(PChar('Simple Bezier Curves'#0)));
+                       tags[4].ti_Tag := TAG_END;
+    s := OpenScreenTagList(nil, @tags);
+    if s = NIL then CleanUpAndDie;
+
+                        tags[0] := TagItem(WA_IDCMP,        IDCMP_CLOSEWINDOW);
+                        tags[1] := TagItem(WA_Left,         0);
+                        tags[2] := TagItem(WA_Top,          s^.BarHeight +1);
+                        tags[3] := TagItem(WA_Width,        s^.Width);
+                        tags[4] := TagItem(WA_Height,       s^.Height - (s^.BarHeight + 1));
+                        tags[5] := TagItem(WA_DepthGadget,  ltrue);
+                        tags[6] := TagItem(WA_DragBar,      ltrue);
+                        tags[7] := TagItem(WA_CloseGadget,  ltrue);
+                        tags[8] := TagItem(WA_ReportMouse,  ltrue);
+                        tags[9] := TagItem(WA_SmartRefresh, ltrue);
+                        tags[10] := TagItem(WA_Activate,     ltrue);
+                        tags[11] := TagItem(WA_Title,        long(PChar('Close the Window to Quit'#0)));
+                        tags[12] := TagItem(WA_CustomScreen, long(s));
+                        tags[13].ti_Tag := TAG_END;
+    w := OpenWindowTagList(nil, @tags);
+    IF w=NIL THEN CleanUpAndDie;
+
+    rp := w^.RPort;
+    Move(rp, 252, 20);
+    Text(rp, PChar('Enter points by pressing the left mouse button'#0), 46);
+    Move(rp, 252, 30);
+    Text(rp, PChar('Double click on the last point to begin drawing'#0), 47);
+    repeat
+        GetPoints;  { Both these routines will quit if }
+        DrawBezier; { the window is closed. }
+    until False;
+    CleanUpAndDie;
+end.

packages/extra/amunits/demos/gtmenu.pas

@@ -0,0 +1,146 @@
+Program GadtoolsMenu;
+
+{* gadtoolsmenu.p
+** Example showing the basic usage of the menu system with a window.
+** Menu layout is done with GadTools, as is recommended for applications.
+**
+*}
+
+uses Exec, Intuition, Utility, GadTools;
+
+{$I tagutils.inc}
+
+const
+
+    mynewmenu : array[0..15] of tNewMenu = (
+    (nm_Type: NM_TITLE; nm_Label:'Project';   nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:'Open...';   nm_CommKey:'O';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:'Save';      nm_CommKey:'S';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:nil;         nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+
+    (nm_Type: NM_ITEM;  nm_Label:'Print';     nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_SUB;   nm_Label:'Draft';     nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_SUB;   nm_Label:'NLQ';       nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:nil;         nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+
+    (nm_Type: NM_ITEM;  nm_Label:'Quit...';   nm_CommKey:'Q';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+
+    (nm_Type: NM_TITLE; nm_Label:'Edit';      nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:'Cut';       nm_CommKey:'X';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:'Copy';      nm_CommKey:'C';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:'Paste';     nm_CommKey:'V';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+    (nm_Type: NM_ITEM;  nm_Label:nil;         nm_CommKey: NIL;  nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+
+    (nm_Type: NM_ITEM;  nm_Label:'Undo';      nm_CommKey:'Z';   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
+
+    (nm_Type:   NM_END; nm_Label:NIL;         nm_CommKey:NIL;   nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL));
+
+var
+   win : pWindow;
+   myVisualInfo : Pointer;
+   menuStrip : pMenu;
+   tags : array[0..6] of tTagItem;
+   msg  : pMessage;
+   done : boolean;
+
+Procedure Die;
+begin
+    if MenuStrip <> nil then begin
+       ClearMenuStrip(win);
+       FreeMenus(MenuStrip);
+    end;
+    if myVisualInfo <> nil then FreeVisualInfo(myVisualInfo);
+    if win <> Nil then CloseWindow(win);
+    if GadToolsBase <> nil then CloseLibrary(GadToolsBase);
+    Halt(0);
+end;
+
+
+
+
+{*
+** Watch the menus and wait for the user to select the close gadget
+** or quit from the menus.
+*}
+PROCEDURE ProcessIDCMP;
+VAR
+    IMessage    : tIntuiMessage;
+    IPtr    : pIntuiMessage;
+
+    Procedure ProcessMenu;
+    var
+    MenuNumber  : Word;
+    ItemNumber  : Word;
+    SubItemNumber   : Word;
+
+    begin
+    if IMessage.Code = MENUNULL then
+        Exit;
+
+    MenuNumber := MenuNum(IMessage.Code);
+    ItemNumber := ItemNum(IMessage.Code);
+    SubItemNumber := SubNum(IMessage.Code);
+
+    if (MenuNumber = 0) and (ItemNumber = 5) then done := true;
+    end;
+
+begin
+    IPtr := pIntuiMessage(Msg);
+    IMessage := IPtr^;
+    ReplyMsg(Msg);
+
+    case IMessage.IClass of
+      IDCMP_MENUPICK    : ProcessMenu;
+      IDCMP_CLOSEWINDOW : done := True;
+    end;
+end;
+
+{*
+** Open all of the required libraries and set-up the menus.
+*}
+
+begin
+    GadToolsBase := OpenLibrary(PChar('gadtools.library'#0), 37);
+    if GadToolsBase = nil then die;
+
+    tags[0] := TagItem(WA_Width,  400);
+    tags[1] := TagItem(WA_Activate,    1);
+    tags[2] := TagItem(WA_Height, 100);
+    tags[3] := TagItem(WA_CloseGadget, 1);
+    tags[4] := TagItem(WA_Title,  Long(PChar('Menu Test Window'#0)));
+    tags[5] := TagItem(WA_IDCMP,  IDCMP_CLOSEWINDOW or IDCMP_MENUPICK);
+    tags[6].ti_Tag := TAG_END;
+    win := OpenWindowTagList(NIL, @tags);
+    if win = nil then die;
+
+    myVisualInfo := GetVisualInfoA(win^.WScreen,nil);
+    if myVisualInfo = nil then die;
+
+    {
+      make the barlabels
+    }
+    mynewmenu[3].nm_Label := PChar(NM_BARLABEL);
+    mynewmenu[7].nm_Label := PChar(NM_BARLABEL);
+    mynewmenu[13].nm_Label := PChar(NM_BARLABEL);
+
+    if pExecBase(_ExecBase)^.LibNode.Lib_Version >= 39 then begin
+        tags[0] := TagItem(GTMN_FrontPen, 1);
+        tags[1].ti_Tag := TAG_END;
+        MenuStrip := CreateMenusA(@mynewmenu,@tags);
+    end else MenuStrip := CreateMenusA(@mynewmenu,NIL);
+
+    if menuStrip = nil then die;
+
+    if not LayoutMenusA(menuStrip, myVisualInfo,nil) then die;
+
+    if not SetMenuStrip(win,menuStrip) then die;
+
+    repeat
+    Msg := WaitPort(win^.UserPort);
+    Msg := GetMsg(win^.UserPort);
+       ProcessIDCMP;
+    until done;
+    die;
+end.
+
+

packages/extra/amunits/demos/imagegadget.pas

@@ -0,0 +1,401 @@
+PROGRAM ImageGadget;
+
+{
+   An example on how to use GadTools gadgets,
+   on the same time how to use images.
+
+   20 Sep 1998.
+   [email protected]
+}
+
+USES Intuition, Exec, Graphics, GadTools, Utility;
+
+{$I tagutils.inc}
+
+CONST
+  MSG_CANT_OPEN_GTLIB  : PChar = 'Can''t open gadtools.library V37 or higher.';
+  MSG_NO_PS            : PChar = 'Can''t lock Public Screen';
+  MSG_NO_VI            : PChar = 'Can''t get Visual Info';
+  MSG_NO_MEM           : PChar = 'Not enough memory free';
+  MSG_NO_WP            : PChar = 'Can''t open window';
+
+  WIN_TITLE            : PChar = 'Images-Example';
+  OK_TEXT              : PChar = 'OK';
+
+  type
+      data = array[1..176] of word;
+      pdata = ^data;
+
+  const
+    renderd : data = (
+    {* Plane 0 *}
+        $0000,$0000,
+        $0000,$0010,
+        $0000,$0010,
+        $0000,$0010,
+        $01C0,$0010,
+        $03E0,$0010,
+        $07F0,$0010,
+        $0000,$0010,
+        $0000,$0810,
+        $039A,$C810,
+        $0000,$0810,
+        $031E,$0810,
+        $0000,$4810,
+        $03E6,$0810,
+        $0000,$0810,
+        $0000,$0810,
+        $07FF,$F810,
+        $0000,$0010,
+        $0000,$0010,
+        $0000,$0010,
+        $0000,$0010,
+        $7FFF,$FFF0,
+    {* Plane 1 *}
+        $FFFF,$FFE0,
+        $8000,$0000,
+        $8000,$0000,
+        $8000,$0000,
+        $81C0,$0000,
+        $83E0,$0000,
+        $87F0,$0000,
+        $8000,$0000,
+        $87FF,$E000,
+        $8465,$2000,
+        $87FF,$E000,
+        $84E1,$E000,
+        $87FF,$A000,
+        $8419,$E000,
+        $87FF,$E000,
+        $8400,$0000,
+        $8000,$0000,
+        $8000,$0000,
+        $8000,$0000,
+        $8000,$0000,
+        $8000,$0000,
+        $0000,$0000,
+    {* Plane 2 *}
+        $0000,$0000,
+        $0000,$0020,
+        $0000,$0020,
+        $0000,$0020,
+        $0000,$0020,
+        $01C0,$0020,
+        $03E0,$0020,
+        $0FFF,$F820,
+        $0800,$1020,
+        $0800,$1020,
+        $0800,$1020,
+        $0800,$1020,
+        $0800,$1020,
+        $0800,$1020,
+        $0800,$1020,
+        $0BFF,$F020,
+        $0800,$0020,
+        $0000,$0020,
+        $0000,$0020,
+        $0000,$0020,
+        $7FFF,$FFE0,
+        $0000,$0000,
+
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000
+    );
+
+     selectd : data = (
+        { Plane 0 }
+                $FFFF,$FFE0,
+                $8000,$0000,
+                $8000,$0000,
+                $8000,$0000,
+                $8000,$0000,
+                $80E0,$0000,
+                $81F0,$0000,
+                $83F8,$0000,
+                $8000,$0000,
+                $8000,$0400,
+                $81CD,$6400,
+                $8000,$0400,
+                $818F,$0400,
+                $8000,$2400,
+                $81F3,$0400,
+                $8000,$0400,
+                $8000,$0400,
+                $83FF,$FC00,
+                $8000,$0000,
+                $8000,$0000,
+                $8000,$0000,
+                $0000,$0000,
+        { Plane 1 }
+                $0000,$0000,
+                $0000,$0010,
+                $0000,$0010,
+                $0000,$0010,
+                $0000,$0010,
+                $00E0,$0010,
+                $01F0,$0010,
+                $03F8,$0010,
+                $0000,$0010,
+                $03FF,$F010,
+                $0232,$9010,
+                $03FF,$F010,
+                $0270,$F010,
+                $03FF,$D010,
+                $020C,$F010,
+                $03FF,$F010,
+                $0200,$0010,
+                $0000,$0010,
+                $0000,$0010,
+                $0000,$0010,
+                $0000,$0010,
+                $7FFF,$FFF0,
+        { Plane 2 }
+                $0000,$0000,
+                $0000,$0020,
+                $0000,$0020,
+                $0000,$0020,
+                $0000,$0020,
+                $0000,$0020,
+                $00E0,$0020,
+                $01F0,$0020,
+                $07FF,$FC20,
+                $0400,$0820,
+                $0400,$0820,
+                $0400,$0820,
+                $0400,$0820,
+                $0400,$0820,
+                $0400,$0820,
+                $0400,$0820,
+                $05FF,$F820,
+                $0400,$0020,
+                $0000,$0020,
+                $0000,$0020,
+                $7FFF,$FFE0,
+                $0000,$0000,
+
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000,
+        $0000,$0000
+                     );
+
+
+VAR
+  ps                : pScreen;
+  vi                : Pointer;
+  ng                : tNewGadget;
+  xoff, yoff,i      : Longint;
+  gl,g              : pGadget;
+  firstimage        : pdata;
+  secondimage       : pdata;
+  renderi,
+  selecti           : tImage;
+  wp                : pWindow;
+  t                 : ARRAY[0..6] OF tTagItem;
+
+
+function NewGadget(left,top,width,height : Integer; txt : PChar; txtattr: pTextAttr;
+                   id : word; flags: Longint; visinfo, userdata : Pointer): tNewGadget;
+var
+    ng : tNewGadget;
+begin
+    with ng do begin
+        ng_LeftEdge   := left;
+        ng_TopEdge    := top;
+        ng_Width      := width;
+        ng_Height     := height;
+        ng_GadgetText := txt;
+        ng_TextAttr   := txtattr;
+        ng_GadgetID   := id;
+        ng_Flags      := flags;
+        ng_VisualInfo := visinfo;
+        ng_UserData   := userdata;
+    END;
+    NewGadget := ng;
+end;
+
+function Image(left,top,width,height,depth: Integer; imdata : pointer;
+               ppick, ponoff: byte; nextim : pImage): tImage;
+var
+    im : tImage;
+begin
+
+        im.LeftEdge    := left;
+        im.TopEdge     := top;
+        im.Width       := width;
+        im.Height      := height;
+        im.Depth       := depth;
+        im.ImageData   := imdata;
+
+        im.PlanePick   := ppick;
+        im.PlaneOnOff  := ponoff;
+
+        im.NextImage   := nextim;
+
+    Image := im;
+end;
+
+
+
+FUNCTION EasyReq(wp : pWindow; title,body,gad : PChar) : Longint;
+VAR
+  es : tEasyStruct;
+BEGIN
+  es.es_StructSize:=SizeOf(tEasyStruct);
+  es.es_Flags:=0;
+  es.es_Title:=title;
+  es.es_TextFormat:=body;
+  es.es_GadgetFormat:=gad;
+
+  EasyReq := EasyRequestArgs(wp,@es,0,NIL);
+END;
+
+PROCEDURE CleanUp(why : PChar; rc : BYTE);
+BEGIN
+  IF wp <> NIL THEN CloseWindow(wp);
+  IF gl <> NIL THEN FreeGadgets(gl);
+  IF vi <> NIL THEN FreeVisualInfo(vi);
+  IF firstimage <> NIL THEN FreeVec(firstimage);
+  IF secondimage <> NIL THEN FreeVec(secondimage);
+   IF why <> nil THEN i := EasyReq(NIL,WIN_TITLE,why,OK_TEXT);
+  IF GadToolsBase <> NIL THEN CloseLibrary(GadToolsBase);
+  HALT(rc);
+END;
+
+{ Clones some datas from default pubscreen for fontsensitive
+  placing of gadgets. }
+PROCEDURE CloneDatas;
+BEGIN
+  ps := LockPubScreen(NIL);
+  IF ps = NIL THEN CleanUp(MSG_NO_PS,20)
+  ELSE
+  BEGIN
+     xoff := ps^.WBorLeft;
+     yoff := ps^.WBorTop + ps^.Font^.ta_YSize + 1;
+     vi := GetVisualInfoA(ps,NIL);
+     UnLockPubScreen(NIL, ps);
+     IF vi = NIL THEN CleanUp(MSG_NO_VI, 20);
+  END;
+END;
+
+procedure AllocateImages;
+begin
+  firstimage := Pointer(AllocVec(SizeOf(data),MEMF_CLEAR OR MEMF_CHIP));
+  if firstimage = nil then CleanUp(MSG_NO_MEM,20);
+
+  firstimage^ := renderd;
+
+  renderi := Image(0,0,28,22,3,firstimage,$ff,$0,nil);
+
+  secondimage := Pointer(AllocVec(SizeOf(data),MEMF_CLEAR OR MEMF_CHIP));
+  if secondimage = nil then CleanUp(MSG_NO_MEM,20);
+
+  secondimage^ := selectd;
+
+  selecti := Image(0,0,28,22,3,secondimage,$ff,$0,nil);
+
+END;
+
+PROCEDURE GenerateWindow;
+BEGIN
+  gl := NIL; gl := CreateContext(addr(gl));
+  IF gl = NIL THEN CleanUp(MSG_NO_MEM, 20);
+  ng := NewGadget(xoff+1,yoff+1,28,22,nil,nil,1,0,vi,nil);
+
+  g := CreateGadgetA(GENERIC_KIND,gl,@ng,NIL);
+  IF g = NIL THEN CleanUp(MSG_NO_MEM, 20);
+
+  g^.GadgetType := GTYP_BOOLGADGET;
+  g^.Flags := GFLG_GADGIMAGE OR GFLG_GADGHIMAGE; { 2 Images }
+  g^.Activation := GACT_RELVERIFY; { Verhalten wie ein BUTTON_KIND-Gadget }
+  g^.GadgetRender := @renderi;
+  g^.SelectRender := @selecti;
+
+  t[0] := TagItem(WA_Gadgets, LONG(gl));
+  t[1].ti_Tag := WA_Title;
+  t[1].ti_Data := long(PChar('Images in Gadgets'#0));
+  t[2] := TagItem(WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
+                  WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
+                        WFLG_ACTIVATE);
+  t[3] := TagItem(WA_Idcmp, IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW);
+  t[4] := TagItem(WA_InnerWidth, 100);
+  t[5] := TagItem(WA_InnerHeight, 50);
+  t[6].ti_Tag := TAG_DONE;
+  wp := OpenWindowTagList(NIL,@t);
+  IF wp = NIL THEN CleanUp(MSG_NO_WP, 20);
+END;
+
+PROCEDURE MainWait;
+VAR
+  msg : pIntuiMessage;
+  iclass : LONG;
+  ende : BOOLEAN;
+BEGIN
+  ende := FALSE;
+  REPEAT
+    msg := pIntuiMessage(WaitPort(wp^.UserPort));
+     msg := GT_GetIMsg(wp^.UserPort);
+     WHILE msg <> NIL DO
+     BEGIN
+        iclass := msg^.IClass;
+        GT_ReplyIMsg(msg);
+        CASE iclass OF
+          IDCMP_CLOSEWINDOW : ende := TRUE;
+          IDCMP_GADGETUP :
+             i := EasyReq(wp,WIN_TITLE,PChar('You have clicked on the Gadget!'#0),pchar('Wheeew!'#0));
+        ELSE END;
+       msg := GT_GetIMsg(wp^.UserPort);
+     END;
+  UNTIL ende;
+END;
+
+BEGIN
+  GadToolsBase := OpenLibrary(GADTOOLSNAME,37);
+  IF GadToolsBase = NIL THEN CleanUp(MSG_CANT_OPEN_GTLIB, 20);
+  new(gl);
+  CloneDatas;
+  AllocateImages;
+  GenerateWindow;
+  MainWait;
+  CleanUp(nil,0);
+END.
+
+

packages/extra/amunits/demos/mapmaker.pas

@@ -0,0 +1,381 @@
+Program MapMaker;
+
+uses Exec, graphics, Intuition, Utility;
+
+{$I tagutils.inc}
+
+{
+    Patrick Quaid.
+    This program just draws a blocky map from straight overhead,
+then repeatedly splits each block into four parts and adjusts the
+elevation of each of the parts until it gets down to one pixel per
+block.  It ends up looking something like a terrain map.  It's kind
+of a fractal thing, but not too much.  Some program a long time ago
+inspired this, but I apologize for forgetting which one.  As I
+recall, that program was derived from Chris Gray's sc.
+    Once upon a time I was thinking about writing an overblown
+strategic conquest game, and this was the first stab at a map
+maker.  The maps it produces look nifty, but have no sense of
+geology so they're really not too useful for a game.
+    When the map is finished, press the left button inside the
+window somewhere and the program will go away.
+}
+
+{
+    Changed the source to 2.0+.
+    12 May 1998.
+
+    Translated to FPC. This was one of the first
+    program I tried with fpc, just to check that
+    the amiga units worked.
+    08 Aug 1998.
+    [email protected]
+}
+
+const
+    MinX = 0;
+    MaxX = 320;
+    MinY = 0;
+    MaxY = 200;
+
+type
+    MapArray = array [MinX .. MaxX - 1, MinY .. MaxY - 1] of Longint;
+
+VAR
+    average,x,y,
+    nextx,nexty,count1,
+    skip,level    : Longint;
+    rp            : pRastPort;
+    vp            : Pointer;
+    s             : pScreen;
+    w             : pWindow;
+    m             : pMessage;
+    Map           : MapArray;
+    Quit          : Boolean;
+    i             : Longint;
+    thetags       : Array[0..12] of tTagItem;
+
+Function FixX(x : Longint): Longint;
+begin
+    if x < 0 then
+    FixX := x + MaxX
+    else if x >= MaxX then
+    FixX := x mod MaxX
+    else
+    FixX := x;
+end;
+
+Function FixY(y : Longint) : Longint;
+begin
+    if x < 0 then
+    FixY := y + MaxY
+    else if x >= MaxY then
+    FixY := y mod MaxY
+    else
+    FixY := y;
+end;
+
+Procedure DrawMap;
+begin
+    if skip = 1 then begin
+    for x := MinX to MaxX - 1 do begin
+        for y := MinY to MaxY - 1 DO begin
+        if Map[x,y] < 100 then begin
+            SetAPen(rp, 0);
+            i := WritePixel(rp, x, y)
+        end else begin
+            average := (Map[x,y] - 100) DIV 6 + 1;
+            if average > 15 then
+            average := 15;
+            SetAPen(rp, average);
+            i := WritePixel(rp, x, y)
+        end
+        end
+    end
+   end else begin
+    x := MinX;
+    while x < MaxX do begin
+        y := MinY;
+        while y < MaxY do begin
+        if Map[x,y] < 100 then begin
+            SetAPen(rp, 0);
+            RectFill(rp,x,y,x + skip - 1,y + skip - 1)
+        end else begin
+            average := (Map[x,y] - 100) DIV 6 + 1;
+            if average > 15 then
+            average := 15;
+            SetAPen(rp,average);
+            RectFill(rp,x,y,x + skip - 1,y + skip - 1);
+        end;
+        y := y + skip;
+        end;
+        x := x + skip;
+    end;
+    end;
+end;
+
+Function Min(x,y : Longint) : Longint;
+begin
+    if x < y then
+    Min := x
+    else
+    Min := y;
+end;
+
+Function Max(x,y : Longint) : Longint;
+begin
+    if x > y then
+    Max := x
+    else
+    Max := y;
+end;
+
+
+Function Height(x,y : Longint) : Longint;
+begin
+    Height := Map[x,y] div 32;
+end;
+
+Procedure ChangeDelta(var d : Longint);
+begin
+    case Random(100) of
+      51..75   : if d < 1 then
+             Inc(d);
+      76..100  : if d > -1 then
+             Dec(d);
+    end;
+end;
+
+Procedure MakeRivers;
+var
+    i    : Longint;
+    x,y,
+    dx,dy  : Longint;
+    OK   : Boolean;
+    LastHeight : Longint;
+    count1      : Longint;
+    cx,cy      : Longint;
+    Search     : Longint;
+    CheckHeight : Longint;
+begin
+    SetAPen(rp, 16);
+
+    for cx := 0 to 319 do begin
+    for cy := 0 to 199 do begin
+        if (Map[cx,cy] > 153) and (Map[cx,cy] < 162) and
+           (Random(100) < 3) then begin
+
+        x := cx;
+        y := cy;
+
+        dx := 0;
+        dy := 0;
+        while (dx = 0) and (dy = 0) do begin
+            dx := Random(2) - 1;
+            dy := Random(2) - 1;
+        end;
+
+        OK := True;
+
+        count1 := 0;
+        while OK do begin
+            LastHeight := Map[x,y]; { Height(x,y); }
+            Map[x,y] := 0;
+            i := WritePixel(rp, x, y);
+
+            CheckHeight := -6;
+            Search := 0;
+            repeat
+                repeat
+                ChangeDelta(dx);
+                ChangeDelta(dy);
+                until (dx <> 0) or (dy <> 0);
+            Inc(Search);
+            if (Map[FixX(x + dx), FixY(y + dy)] > 0) and
+                         {  (Height(FixX(x + dx), FixY(y + dy)) < CheckHeight) then begin }
+               (Map[FixX(x + dx), FixY(y + dy)] < (LastHeight + CheckHeight)) then begin
+                x := FixX(x + dx);
+                y := FixY(y + dy);
+                Search := 0;
+            end else if Search > 200 then begin
+                if CheckHeight < 6 then begin
+                Inc(CheckHeight,2);
+                Search := 1;
+                end else begin
+                Search := 0;
+                OK := False;
+                end;
+            end;
+            until Search = 0;
+
+            Inc(count1);
+            if count1 > 150 then
+            OK := False;
+            if Map[x,y] < 100 then
+            OK := False;
+        end;
+        end;
+    end;
+    end;
+end;
+
+Procedure MakeMap;
+begin
+
+    rp:= w^.RPort;
+    vp:= ViewPortAddress(w);
+
+    SetRGB4(vp, 0, 0, 0, 12); { Ocean Blue }
+    SetRGB4(vp, 1, 1, 1, 0);
+    SetRGB4(vp, 2, 0, 3, 0);
+    SetRGB4(vp, 3, 0, 4, 0); { Dark Green }
+    SetRGB4(vp, 4, 0, 5, 0);
+    SetRGB4(vp, 5, 1, 6, 0);
+    SetRGB4(vp, 6, 2, 8, 0); { Medium Green }
+    SetRGB4(vp, 7, 4, 10, 0);
+    SetRGB4(vp, 8, 6, 10, 0);
+    SetRGB4(vp, 9, 9, 9, 0); { Brown }
+    SetRGB4(vp, 10, 8, 8, 0);
+    SetRGB4(vp, 11, 7, 7, 0); { Dark Brown }
+    SetRGB4(vp, 12, 10, 10, 0); { Dark Grey }
+    SetRGB4(vp, 13, 10, 10, 10);
+    SetRGB4(vp, 14, 12, 12, 12);
+    SetRGB4(vp, 15, 14, 14, 15); { White }
+    SetRGB4(vp, 16, 0, 0, 10);   { River blue }
+
+    Randomize; { Seed the Random Number Generator }
+
+    level := 7;
+    skip  := 16;
+
+    y := MinY;
+    while y < MaxY do begin
+    x := MinX;
+    while x < MaxX do begin
+        Map[x,y] := Random(220);
+        x := x + skip;
+    end;
+    y := y + skip;
+    end;
+
+    DrawMap;
+
+    for level := 2 to 5 do begin
+    skip := skip DIV 2;
+    y := MinY;
+    while y < MaxY do begin
+        if (y MOD (2*skip)) = 0 then
+        nexty := skip * 2
+        else
+        nexty:=skip;
+        x := MinX;
+        while x < MaxX do begin
+        if (x MOD (2*skip)) = 0 then
+            nextx := skip * 2
+        else
+            nextx := skip;
+        if (nextx = skip * 2) AND (nexty = skip * 2) then begin
+            average := Map[x,y] * 5;
+            count1 := 9;
+        end else begin
+            average := 0;
+            count1 := 4;
+        end;
+        if (nextx = skip * 2) then begin
+            average := average + Map[x,FixY(y - skip)];
+            average := average + Map[x,FixY(y + nexty)];
+            count1 := count1 + 2;
+        end;
+        if (nexty = skip * 2) then begin
+            average := average + Map[FixX(x - skip),y];
+            average := average + Map[FixX(x + nextx),y];
+            count1 := count1 + 2;
+        end;
+        average := average + Map[FixX(x-skip),FixY(y-skip)]
+                   + Map[FixX(x-nextx),FixY(y+nexty)]
+                   + Map[FixX(x+skip),FixY(y-skip)]
+                   + Map[FixX(x+nextx),FixY(y+nexty)];
+        average := (average DIV count1) +
+                (Random(4) - 2) * (9 - level);
+        case Average of
+          150..255 : Average := Average + 2;
+          100..149 : Inc(Average);
+        else
+            Average := Average - 3;
+        end;
+        if average < 0 then
+            average := 0;
+        if average > 220 then
+            average := 220;
+        Map[x,y] := average;
+
+        x := x + skip;
+        end;
+        m := GetMsg(w^.UserPort);
+        if m <> Nil then begin
+        Quit := True;
+        Exit;
+        end;
+        y := y + skip;
+    end;
+    DrawMap;
+    end;
+    MakeRivers;
+end;
+
+begin
+    GfxBase := OpenLibrary(GRAPHICSNAME,0);
+    if GfxBase <> nil then begin
+    thetags[0] := TagItem(SA_Left,      0);
+    thetags[1] := TagItem(SA_Top,       0);
+    thetags[2] := TagItem(SA_Width,     320);
+    thetags[3] := TagItem(SA_Height,    200);
+    thetags[4] := TagItem(SA_Depth,     5);
+    thetags[5] := TagItem(SA_DetailPen, 3);
+    thetags[6] := TagItem(SA_BlockPen,  2);
+    thetags[7] := TagItem(SA_Type,      CUSTOMSCREEN_f);
+    thetags[8].ti_Tag := TAG_END;
+
+    s := OpenScreenTagList(NIL,@thetags);
+
+    if s <> NIL then begin
+
+        thetags[0]  := TagItem(WA_IDCMP,        IDCMP_MOUSEBUTTONS);
+        thetags[1]  := TagItem(WA_Left,         MinX);
+        thetags[2]  := TagItem(WA_Top,          MinY);
+        thetags[3]  := TagItem(WA_Width,        MaxX);
+        thetags[4]  := TagItem(WA_Height,       MaxY);
+        thetags[5]  := TagItem(WA_MinWidth,     50);
+        thetags[6]  := TagItem(WA_MinHeight,    20);
+        thetags[7]  := TagItem(WA_Borderless,   1);
+        thetags[8]  := TagItem(WA_BackDrop,     1);
+        thetags[9]  := TagItem(WA_SmartRefresh, 1);
+        thetags[10] := TagItem(WA_Activate,     1);
+        thetags[11] := TagItem(WA_CustomScreen, longint(s));
+        thetags[12].ti_Tag := TAG_END;
+
+        w := OpenWindowTagList(NIL,@thetags);
+
+        IF w <> NIL THEN begin
+        Quit := False;
+        ShowTitle(s, 0);
+        MakeMap;
+        if not Quit then
+            m := WaitPort(w^.UserPort);
+        Forbid;
+        repeat
+            m := GetMsg(w^.UserPort);
+        until m = nil;
+        CloseWindow(w);
+        Permit;
+        end else
+        writeln('Could not open the window.');
+        CloseScreen(s);
+    end else
+        writeln('Could not open the screen.');
+    CloseLibrary(GfxBase);
+    end else writeln('no graphics.library');
+end.
+
+
+

packages/extra/amunits/demos/moire.pas

@@ -0,0 +1,122 @@
+Program Moire;
+
+{
+      Will now open a default screen (can be any size) with
+      the new look. The window get it's size depending on
+      the screen size.
+      14 May 1998
+
+      Translated to FPC from PCQ Pascal.
+      15 Aug 1998.
+      [email protected]
+}
+
+uses Exec, Intuition, Graphics, Utility;
+
+{$I tagutils.inc}
+
+const
+    pens : array [0..0] of Integer = ( not 0);
+    ltrue = 1;
+
+var
+    w  : pWindow;
+    s  : pScreen;
+    m  : pMessage;
+    thetags : array[0..17] of tTagItem;
+
+
+Procedure DoDrawing(RP : pRastPort);
+var
+    x  : word;
+    Pen : Byte;
+    Stop : word;
+begin
+    Pen := 1;
+    while true do begin
+    with w^ do begin
+        x := 0;
+        while x < Pred(Width - BorderRight - BorderLeft) do begin
+        Stop := Pred(Width - BorderRight);
+        SetAPen(RP, Pen);
+        Move(RP, Succ(x + BorderLeft), BorderTop);
+        Draw(RP, Stop - x, Pred(Height - BorderBottom));
+        Pen := (Pen + 1) mod 4;
+        Inc(x);
+        end;
+        m := GetMsg(UserPort);
+        if m <> Nil then
+        Exit;
+        x := 0;
+        while x < Pred(Height - BorderBottom - BorderTop) do begin
+        Stop := Pred(Height - BorderBottom);
+        SetAPen(RP, Pen);
+        Move(RP, Pred(Width - BorderRight), Succ(x + BorderTop));
+        Draw(RP, Succ(BorderLeft), Stop - x);
+        Pen := (Pen + 1) mod 4;
+        Inc(x);
+        end;
+        m := GetMsg(UserPort);
+        if m <> Nil then
+        Exit;
+    end;
+    end;
+end;
+
+begin
+    { Note that the startup code of all FPC programs depends on
+      Intuition, so if we got to this point Intuition must be
+      open, so the run time library just uses the pointer that
+      the startup code created.  Same with DOS, although we don't
+      use that here. }
+
+    GfxBase := OpenLibrary(GRAPHICSNAME,0);
+    if GfxBase <> nil then begin
+
+    thetags[0] := TagItem(SA_Pens,      longint(@pens));
+    thetags[1] := TagItem(SA_Depth,     2);
+    thetags[2] := TagItem(SA_DisplayID, HIRES_KEY);
+    thetags[3] := TagItem(SA_Title,     Long(PChar('Close the Window to End This Demonstration'#0)));
+    thetags[4].ti_Tag := TAG_END;
+
+    s := OpenScreenTagList(NIL, @thetags);
+    if s <> NIL then begin
+
+    thetags[0] := TagItem(WA_IDCMP,        IDCMP_CLOSEWINDOW);
+    thetags[1] := TagItem(WA_Left,         20);
+    thetags[2] := TagItem(WA_Top,          50);
+    thetags[3] := TagItem(WA_Width,        336);
+    thetags[4] := TagItem(WA_Height,       100);
+    thetags[5] := TagItem(WA_MinWidth,     50);
+    thetags[6] := TagItem(WA_MinHeight,    20);
+    thetags[7] := TagItem(WA_MaxWidth,     -1);
+    thetags[8] := TagItem(WA_MaxHeight,    -1);
+    thetags[9] := TagItem(WA_DepthGadget,  ltrue);
+    thetags[10] := TagItem(WA_DragBar,      -1);
+    thetags[11] := TagItem(WA_CloseGadget,  -1);
+    thetags[12] := TagItem(WA_SizeGadget,   -1);
+    thetags[13] := TagItem(WA_SmartRefresh, -1);
+    thetags[14] := TagItem(WA_Activate,     -1);
+    thetags[15] := TagItem(WA_Title,        Long(PChar('Feel Free to Re-Size the Window'#0)));
+    thetags[16] := TagItem(WA_CustomScreen, Long(s));
+    thetags[17].ti_Tag := TAG_END;
+
+    w := OpenWindowTagList(NIL, @thetags);
+    IF w <> NIL THEN begin
+
+        DoDrawing(w^.RPort);
+        Forbid;
+        repeat
+            m := GetMsg(w^.UserPort);
+        until m = nil;
+        CloseWindow(w);
+        Permit;
+        end else
+        writeln('Could not open the window');
+        CloseScreen(s);
+    end else
+        writeln('Could not open the screen.');
+    CloseLibrary(GfxBase);
+    end else writeln('no graphics.library');
+end.
+

packages/extra/amunits/demos/sortdemo.pas

@@ -0,0 +1,616 @@
+PROGRAM SortDemo;
+
+{ Graphical demonstration of sorting algorithms (W. N~ker, 02/96) }
+{ based on "Sortieren" of Purity #48 }
+
+{
+    Translated to PCQ from Kick(Maxon) Pascal.
+    Updated the source to 2.0+.
+    Now uses GadTools for menus.
+    Added CloseWindowSafely.
+    Cleaned up the menuhandling.
+    Added LockWinSize and RestoreWin, now the
+    window will be locked on showtime.
+
+    The German text was translated to English
+    by Andreas Neumann, thanks Andreas.
+    Jun 03 1998.
+
+    Translated to FPC Pascal.
+    Removed CloseWindowSafely, have do add
+    that procedure to Intuition.
+    Fixed a bug, when you halt the show the
+    window stayed locked.
+    Aug 23 1998.
+
+    [email protected]
+
+    One last remark, the heapsort can't be stoped
+    so you have to wait until it's finished.
+}
+
+uses Exec, Intuition, Graphics, Utility, GadTools;
+
+{$I tagutils.inc}
+
+CONST version : PChar = '$VER: SortDemo 1.3  (23-Aug-98)';
+
+      nmax=2000;
+
+      MinWinX = 80;
+      MinWiny = 80;
+
+      w         : pWindow  = Nil;
+      s         : pScreen  = Nil;
+      MenuStrip : pMenu    = Nil;
+      vi        : Pointer  = Nil;
+      ltrue     : longint  = -1;
+
+      modenames : Array[0..7] of string[10] = (
+                                'Heapsort',
+                                'Shellsort',
+                                'Pick out',
+                                'Insert',
+                                'Shakersort',
+                                'Bubblesort',
+                                'Quicksort',
+                                'Mergesort');
+
+      { The easiest way to use gadtoolsmenus in FPC is
+        to have them as const types. No need to cast
+        strings to PChar. That we have to use recordmembers
+        name is a pain.
+      }
+
+      nm : array[0..21] of tNewMenu = (
+      (nm_Type: NM_TITLE; nm_Label: 'Demo';        nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'Start';       nm_CommKey: 'S'; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'Stop';        nm_CommKey: 'H'; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+
+      { this will be a barlabel, have to set this one later }
+      (nm_Type: NM_ITEM;  nm_Label: NIL;           nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+
+      (nm_Type: NM_ITEM;  nm_Label: 'Quit';        nm_CommKey: 'Q'; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_TITLE; nm_Label: 'Algorithm';   nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'HeapSort';    nm_CommKey: '1'; nm_Flags: CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 254; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'ShellSort';   nm_CommKey: '2'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 253; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'Pick out';    nm_CommKey: '3'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 251; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'Insert';      nm_CommKey: '4'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 247; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'ShakerSort';  nm_CommKey: '5'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 239; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'BubbleSort';  nm_CommKey: '6'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 223; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'QuickSort';   nm_CommKey: '7'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 191; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'MergeSort';   nm_CommKey: '8'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 127; nm_UserData: NIL),
+      (nm_Type: NM_TITLE; nm_Label: 'Preferences'; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'Data';        nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_SUB;   nm_Label: 'Random';      nm_CommKey: 'R'; nm_Flags: CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 2; nm_UserData: NIL),
+      (nm_Type: NM_SUB;   nm_Label: 'Malicious';   nm_CommKey: 'M'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 1; nm_UserData: NIL),
+      (nm_Type: NM_ITEM;  nm_Label: 'Diagram';     nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
+      (nm_Type: NM_SUB;   nm_Label: 'Needles';     nm_CommKey: 'N'; nm_Flags: CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 2; nm_UserData: NIL),
+      (nm_Type: NM_SUB;   nm_Label: 'Dots';        nm_CommKey: 'D'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 1; nm_UserData: NIL),
+      (nm_Type: NM_END;   nm_Label: NIL;           nm_CommKey: NIL; nm_Flags: 0;nm_MutualExclude:0;nm_UserData:NIL));
+
+
+VAR sort: ARRAY[1..nmax] OF Real;
+    sort2: ARRAY[1..nmax] OF Real;  { for dumb Mergesort %-( }
+    num,range,modus : Integer;
+    rndom,needles   : Boolean;
+    Rast            : pRastPort;
+    QuitStopDie     : Boolean;
+    Msg             : pMessage;
+    wintitle        : string[80];
+    scrtitle        : string[80];
+    tags            : array[1..18] of tTagItem;
+
+Procedure CleanUp(s : string; err : Integer);
+begin
+    if MenuStrip <> nil then begin
+       ClearMenuStrip(w);
+       FreeMenus(MenuStrip);
+    end;
+    if vi <> nil then FreeVisualInfo(vi);
+    if w <> nil then CloseWindow(w);
+    if GfxBase <> nil then CloseLibrary(GfxBase);
+    if GadToolsBase <> nil then CloseLibrary(GadToolsBase);
+    if s <> '' then writeln(s);
+    Halt(err);
+end;
+
+Procedure RestoreWin;
+var
+   dummy : Boolean;
+begin
+   dummy := WindowLimits(w,MinWinX,MinWinY,-1,-1);
+end;
+
+Procedure LockWinSize(x,y,x2,y2 : Integer);
+var
+   dummy : Boolean;
+begin
+   dummy := WindowLimits(w,x,y,x2,y2);
+end;
+
+FUNCTION cancel: Boolean;
+{ checked while sorting }
+VAR m,i,s: Integer;
+    result : boolean;
+    IM : pIntuiMessage;
+BEGIN
+  result := False;
+  IM := pIntuiMessage(GetMsg(w^.UserPort));
+  IF IM<>Nil THEN BEGIN
+    IF IM^.IClass=IDCMP_CLOSEWINDOW THEN
+      result := True;   { Close-Gadget }
+    IF IM^.IClass=IDCMP_MENUPICK THEN BEGIN
+      m := IM^.Code AND $1F;
+      i := (IM^.Code SHR 5) AND $3F;
+      s := (IM^.Code SHR 11) AND $1F;
+      IF (m=0) AND (i=1) THEN  result := True;  { Menu item "Stop" }
+    END;
+    ReplyMsg(pMessage(Msg));
+  END;
+  cancel := result;
+END;
+
+
+PROCEDURE showstack(size: Integer);
+{ little diagram showing the depth of Quicksort's recursion :-) }
+BEGIN
+  SetAPen(Rast,2); IF size>0 THEN RectFill(Rast,0,0,3,size-1);
+  SetAPen(Rast,0); RectFill(Rast,0,size,3,size);
+END;
+
+
+PROCEDURE setpixel(i: Integer);
+BEGIN
+  SetAPen(Rast,1);
+  IF needles THEN BEGIN
+    Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
+  END ELSE
+    IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
+END;
+
+PROCEDURE clearpixel(i: Integer);
+BEGIN
+  SetAPen(Rast,0);
+  IF needles THEN BEGIN
+    Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
+  END ELSE
+    IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
+END;
+
+procedure Exchange(var first,second : real);
+var
+  temp : real;
+begin
+  temp := first;
+  first := second;
+  second := temp;
+end;
+
+PROCEDURE swapit(i,j: integer);
+BEGIN
+  clearpixel(i); clearpixel(j);
+  Exchange(sort[i],sort[j]);
+  setpixel(i); setpixel(j);
+END;
+
+FUNCTION descending(i,j: Integer): Boolean;
+BEGIN
+  descending := sort[i]>sort[j];
+END;
+
+Function IntToStr (I : Longint) : String;
+
+     Var S : String;
+
+     begin
+      Str (I,S);
+      IntToStr:=S;
+     end;
+
+
+PROCEDURE settitles(time: Longint);
+VAR
+  s : string[80];
+BEGIN
+  s := modenames[modus];
+  IF time=0 THEN
+    wintitle := s + ' running ...'
+  ELSE IF time < 0 then
+    wintitle := '<- ' + IntToStr(num) + ' Data ->'
+  ELSE
+    wintitle := IntToStr(time) + ' Seconds';
+  scrtitle := strpas(@version[6]) + ' - ' + s;
+  wintitle := wintitle + #0;
+  scrtitle := scrtitle + #0;
+  SetWindowTitles(w,@wintitle[1],@scrtitle[1]);
+END;
+
+PROCEDURE refresh;
+{ react on new size of window/init data }
+VAR i: Integer;
+BEGIN
+  num := w^.GZZWidth; IF num>nmax THEN num := nmax;
+  range := w^.GZZHeight;
+  settitles(-1);
+  SetRast(Rast,0);    { clear screen }
+  FOR i := 1 TO num DO BEGIN
+    IF rndom THEN sort[i] := Random  { produces 0..1 }
+      ELSE sort[i] := (num-i)/num;
+    setpixel(i);
+  END;
+END;
+
+{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
+{ *#*#*#*#*#*#*#*#*#*#*# The sorting algorithms! #*#*#*#*#*#*#*#*#*#*#*#* }
+{ *#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#*#* }
+
+PROCEDURE bubblesort;
+{ like the head of a beer, reaaal slow and easy-going }
+VAR i,j,max: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  max := num;
+  REPEAT
+    j := 1;
+    FOR i := 1 TO max-1 DO
+      IF descending(i,i+1) THEN BEGIN
+        swapit(i,i+1); j := i;
+      END;
+    max := j;
+  UNTIL (max=1) OR cancel;
+  RestoreWin;
+END;
+
+PROCEDURE shakersort;
+{ interesting variant, but bubblesort still remains hopelessness }
+{ (because it only compares and swaps immediate adjacent units)  }
+VAR i,j,min,max: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  min := 1;
+  max := num;
+  REPEAT
+    j := min;
+    FOR i := min TO max-1 DO
+      IF descending(i,i+1) THEN BEGIN
+        swapit(i,i+1); j := i;
+      END;
+    max := j;
+    j := max;
+    FOR i := max DOWNTO min+1 DO
+      IF descending(i-1,i) THEN BEGIN
+        swapit(i,i-1); j := i;
+      END;
+    min := j;
+  UNTIL (max=min) OR cancel;
+  RestoreWin;
+END;
+
+PROCEDURE e_sort;
+{ Insert: a pretty human strategy }
+VAR i,j: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  FOR i := 2 TO num DO BEGIN
+    j := i;
+    WHILE j>1 DO
+      IF descending(j-1,j) THEN BEGIN
+        swapit(j-1,j); Dec(j);
+      END ELSE
+        j := 1;
+    IF cancel THEN begin
+        RestoreWin;
+        Exit;
+    end;
+  END;
+  RestoreWin;
+END;
+
+PROCEDURE a_sort;
+{ Pick out: Preparation is one half of a life }
+{ Take a look at the ridiculous low percentage of successful comparisions:  }
+{ Although there are only n swaps, there are n^2/2 comparisions!            }
+{ Both is a record, one in a good sense, the other one in a bad sense.      }
+
+VAR i,j,minpos: Integer;
+    min: Real;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  FOR i := 1 TO num-1 DO BEGIN
+    minpos := i; min := sort[i];
+    FOR j := i+1 TO num DO
+      IF descending(minpos,j) THEN
+        minpos := j;
+    IF minpos<>i THEN swapit(i,minpos);
+    IF cancel THEN begin
+        RestoreWin;
+        Exit;
+    end;
+  END;
+  RestoreWin;
+END;
+
+PROCEDURE shellsort;
+{ brilliant extension of E-Sort, stunning improvement of efficience }
+VAR i,j,gap: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  gap := num DIV 2;
+  REPEAT
+    FOR i := 1+gap TO num DO BEGIN
+      j := i;
+      WHILE j>gap DO
+        IF descending(j-gap,j) THEN BEGIN
+          swapit(j,j-gap); j := j-gap;
+        END ELSE
+          j := 1;
+      IF cancel THEN begin
+          RestoreWin;
+          Exit;
+      end;
+    END;
+    gap := gap DIV 2;
+  UNTIL gap=0;
+  RestoreWin;
+END;
+
+PROCEDURE seepaway(i,max: Integer);
+{ belongs to heapsort }
+VAR j: Integer;
+BEGIN
+  j := 2*i;
+  WHILE j<=max DO BEGIN
+    IF j<max THEN IF descending(j+1,j) THEN
+      Inc(j);
+    IF descending(j,i) THEN BEGIN
+      swapit(j,i);
+      i := j; j := 2*i;
+    END ELSE
+      j := max+1; { cancels }
+  END;
+END;
+
+PROCEDURE heapsort;
+{ this genius rules over the chaos: it's the best algorithm, I know about    }
+{ The only disadvantage compared with shellsort: it's not easy to understand }
+{ and impossible to know it by heart. }
+VAR i,j: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  i := num DIV 2 + 1;
+  j := num;
+  WHILE i>1 DO BEGIN
+    Dec(i); seepaway(i,j);
+  END;
+  WHILE j>1 DO BEGIN
+    swapit(i,j);
+    Dec(j); seepaway(i,j);
+  END;
+  RestoreWin;
+END;
+
+PROCEDURE quicksort;
+{ "divide and rule": a classic, but recursive  >>-( }
+{ In this demonstration it is faster than heapsort, but does considerable }
+{ more unsuccessful comparisions. }
+VAR stack: ARRAY[1..100] OF RECORD li,re: Integer; END;
+    sp,l,r,m,i,j: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  sp := 1; stack[1].li := 1; stack[1].re := num;
+  REPEAT
+    l := stack[sp].li; r := stack[sp].re; Dec(sp);
+    showstack(sp);
+    m := (l+r) DIV 2;
+    i := l; j := r;
+    REPEAT
+      WHILE descending(m,i) DO Inc(i);
+      WHILE descending(j,m) DO Dec(j);
+      IF j>i THEN swapit(i,j);
+      IF m=i THEN m := j ELSE IF m=j THEN m := i; { ahem ... }
+      { This "Following" of the reference data is only required because  }
+      { I stubborn call the comparision function, and this one only gets }
+      { indices on the values which have to be compared. }
+    UNTIL i>=j;
+    IF i>l THEN BEGIN
+      Inc(sp); stack[sp].li := l; stack[sp].re := i; END;
+    IF i+1<r THEN BEGIN
+      Inc(sp); stack[sp].li := i+1; stack[sp].re := r; END;
+  UNTIL (sp=0) OR cancel;
+  RestoreWin;
+END;
+
+PROCEDURE mergesort;
+{ *the* algorithm for lists with pointers on it, for arrays rather }
+{ inacceptable. The non.recursive implementation came out pretty more }
+{ complicated than the one for quicksort, as quicksort first does }
+{ something and then recurses; with mergesort it is the other way round. }
+VAR stack: ARRAY[1..100] OF RECORD li,re,mi: Integer; END;
+    sp,l,r,i,j,k,m: Integer;
+BEGIN
+  LockWinSize(w^.Width,w^.Height,w^.Width,w^.Height);
+  sp := 1; stack[1].li := 1; stack[1].re := num; stack[1].mi := 0;
+  REPEAT
+    l := stack[sp].li; r := stack[sp].re; m := stack[sp].mi; Dec(sp);
+    showstack(sp);
+    IF m>0 THEN BEGIN { put two halfs together }
+      { Unfortunately it is only possible in an efficient way by using }
+      { extra memory; mergesort really is something for lists with }
+      { pointers originally ... }
+      FOR i := m DOWNTO l do sort2[i] := sort[i];  i := l;
+      FOR j := m+1 TO r DO sort2[r+m+1-j] := sort[j];  j := r;
+      FOR k := l TO r DO BEGIN
+        clearpixel(k);
+        IF sort2[i]<sort2[j] THEN BEGIN
+          sort[k] := sort2[i]; Inc(i);
+        END ELSE BEGIN
+          sort[k] := sort2[j]; Dec(j);
+        END;
+        setpixel(k);
+      END;
+    END ELSE IF l<r THEN BEGIN
+      { create two halfs and the order to put them together }
+      m := (l+r) DIV 2;
+      Inc(sp); stack[sp].li := l; stack[sp].mi := m; stack[sp].re := r;
+      Inc(sp); stack[sp].li := m+1; stack[sp].mi := 0; stack[sp].re := r;
+      Inc(sp); stack[sp].li := l; stack[sp].mi := 0; stack[sp].re := m;
+    END;
+  UNTIL (sp=0) OR cancel;
+  RestoreWin;
+END;
+
+
+Procedure OpenEverything;
+begin
+    GadToolsBase := OpenLibrary(PChar('gadtools.library'#0),37);
+    if GadToolsBase = nil then CleanUp('Can''t open gadtools.library',20);
+    GfxBase := OpenLibrary(GRAPHICSNAME,37);
+    if GfxBase = nil then CleanUp('Can''t open graphics.library',20);
+
+    s := LockPubScreen(nil);
+    if s = nil then CleanUp('Could not lock pubscreen',10);
+
+    vi := GetVisualInfoA(s, NIL);
+    if vi = nil then CleanUp('No visual info',10);
+
+                tags[1] := TagItem(WA_IDCMP,         IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or IDCMP_NEWSIZE);
+                tags[2] := TagItem(WA_Left,          0);
+                tags[3] := TagItem(WA_Top,           s^.BarHeight+1);
+                tags[4] := TagItem(WA_Width,         224);
+                tags[5] := TagItem(WA_Height,        s^.Height-(s^.BarHeight-1));
+                tags[6] := TagItem(WA_MinWidth,      MinWinX);
+                tags[7] := TagItem(WA_MinHeight,     MinWinY);
+                tags[8] := TagItem(WA_MaxWidth,      -1);
+                tags[9] := TagItem(WA_MaxHeight,     -1);
+                tags[10] := TagItem(WA_DepthGadget,   ltrue);
+                tags[11] := TagItem(WA_DragBar,       ltrue);
+                tags[12] := TagItem(WA_CloseGadget,   ltrue);
+                tags[13] := TagItem(WA_SizeGadget,    ltrue);
+                tags[14] := TagItem(WA_Activate,      ltrue);
+                tags[15] := TagItem(WA_SizeBRight,    ltrue);
+                tags[16] := TagItem(WA_GimmeZeroZero, ltrue);
+                tags[17] := TagItem(WA_PubScreen,     longint(s));
+                tags[18].ti_Tag := TAG_END;
+    w := OpenWindowTagList(NIL, @tags[1]);
+    IF w=NIL THEN CleanUp('Could not open window',20);
+
+    Rast := w^.RPort;
+
+    { Here we set the barlabel }
+    nm[3].nm_Label := PChar(NM_BARLABEL);
+
+    if pExecBase(_ExecBase)^.LibNode.Lib_Version >= 39 then begin
+        tags[1] := TagItem(GTMN_FrontPen, 1);
+        tags[2].ti_Tag := TAG_END;
+        MenuStrip := CreateMenusA(@nm,@tags[1]);
+    end else MenuStrip := CreateMenusA(@nm,NIL);
+
+    if MenuStrip = nil then CleanUp('Could not open Menus',10);
+    if LayoutMenusA(MenuStrip,vi,NIL)=false then
+        CleanUp('Could not layout Menus',10);
+
+    if SetMenuStrip(w, MenuStrip) = false then
+        CleanUp('Could not set the Menus',10);
+
+end;
+
+PROCEDURE ProcessIDCMP;
+VAR
+    IMessage    : tIntuiMessage;
+    IPtr    : pIntuiMessage;
+
+    Procedure ProcessMenu;
+    var
+    MenuNumber  : Integer;
+    ItemNumber  : Integer;
+    SubItemNumber   : Integer;
+    t0,t1,l         : Longint;
+
+    begin
+    if IMessage.Code = MENUNULL then
+        Exit;
+
+    MenuNumber := MenuNum(IMessage.Code);
+    ItemNumber := ItemNum(IMessage.Code);
+    SubItemNumber := SubNum(IMessage.Code);
+
+    case MenuNumber of
+      0 : begin
+          case ItemNumber of
+             0 : begin
+                   refresh;
+                   settitles(0);
+                   CurrentTime(t0,l);
+                   CASE modus OF
+                     0: heapsort;
+                     1: shellsort;
+                     2: a_sort;
+                     3: e_sort;
+                     4: shakersort;
+                     5: bubblesort;
+                     6: quicksort;
+                     7: mergesort;
+                   END;
+                   CurrentTime(t1,l);
+                   settitles(t1-t0);
+                 end;
+             3 : QuitStopDie := True;
+          end;
+          end;
+      1 : begin
+          case ItemNumber of
+              0..7 : modus := ItemNumber;
+          end;
+          settitles(-1);
+          end;
+      2 : begin
+          case ItemNumber of
+             0 : begin
+                 case SubItemNumber of
+                    0 : if not rndom then rndom := true;
+                    1 : if rndom then rndom := false;
+                 end;
+                 end;
+             1 : begin
+                 case SubItemNumber of
+                    0 : if not needles then needles := true;
+                    1 : if needles then needles := false;
+                 end;
+                 end;
+          end;
+          end;
+    end;
+    end;
+
+begin
+    IPtr := pIntuiMessage(Msg);
+    IMessage := IPtr^;
+    ReplyMsg(Msg);
+
+    case IMessage.IClass of
+      IDCMP_MENUPICK    : ProcessMenu;
+      IDCMP_NEWSIZE     : refresh;
+      IDCMP_CLOSEWINDOW : QuitStopDie := True;
+    end;
+end;
+
+
+
+begin
+   OpenEverything;
+   QuitStopDie := False;
+   modus := 0;
+   needles := true;
+   rndom := true;
+   refresh;
+   repeat
+   Msg := WaitPort(w^.UserPort);
+   Msg := GetMsg(w^.UserPort);
+       ProcessIDCMP;
+   until QuitStopDie;
+   CleanUp('',0);
+end.
+
+
+

packages/extra/amunits/demos/stars.pas

@@ -0,0 +1,157 @@
+PROGRAM Sterne;
+
+
+uses Exec, Graphics, Intuition, Utility;
+
+{$I tagutils.inc}
+
+CONST   MAX_STERNE = 42;
+        MAX_GESCHW = 15;
+
+TYPE    Star = packed Record
+                 x,y :Integer;
+                 msin :Real;
+                 mcos :Real;
+                 d   :Integer;
+                 v   :Integer;
+               End;
+
+VAR     Scr     :pScreen;
+        Win     :pWindow;
+        Msg     :pIntuiMessage;
+        Ende    :Boolean;
+        Stars   :Array[1..MAX_STERNE] of Star;
+        factor  :Real;
+        col     :Integer;
+        dum     :Longint;
+
+
+PROCEDURE newStern(num :Integer);
+
+BEGIN
+  col:=Random(360);
+  Stars[num].x := Scr^.Width shr 1;
+  Stars[num].y := Scr^.Height shr 1;
+  Stars[num].msin := sin(col*factor);
+  Stars[num].mcos := cos(col*factor);
+  Stars[num].d := 0;
+  Stars[num].v := Random(MAX_GESCHW)+2;
+END;
+
+
+PROCEDURE moveStern(num :Integer);
+
+BEGIN
+  Stars[num].d:=Stars[num].d+Stars[num].v;
+  Stars[num].x:=Round(Stars[num].d*Stars[num].msin)+Scr^.Width shr 1;
+  Stars[num].y:=Round(Stars[num].d*Stars[num].mcos)+Scr^.Height shr 1;
+  {Inc(Stars[num].v);}
+END;
+
+
+PROCEDURE drawSterne;
+
+BEGIN
+  For dum:=1 to MAX_STERNE Do Begin
+    If Stars[dum].v=0 Then Begin
+      If Random(10)>4 Then
+        newStern(dum);
+    End Else If Stars[dum].d>Scr^.Width shr 1 Then Begin
+      SetAPen(Win^.RPort,0);
+      If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
+      Stars[dum].v:=0;
+    End Else Begin
+      SetAPen(Win^.RPort,0);
+      If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
+      moveStern(dum);
+      col:=(Stars[dum].d shl 5) Div Scr^.Height shr 1;
+      If col>7 Then
+        col:=7;
+      SetAPen(Win^.RPort,col);
+      If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
+    End;
+  End;
+END;
+
+
+PROCEDURE initSterne;
+
+BEGIN
+  For dum:=1 to MAX_STERNE Do begin
+    Stars[dum].x := Scr^.Width shr 1;
+    Stars[dum].y := Scr^.Height shr 1;
+    Stars[dum].msin := 0.0;
+    Stars[dum].mcos := 0.0;
+    Stars[dum].d := 0;
+    Stars[dum].v := 0;
+  end;
+  factor:=PI/180;
+END;
+
+
+PROCEDURE CleanUp(str:string; code : Longint);
+
+BEGIN
+  If Win<>Nil Then
+    CloseWindow(Win);
+  If (Scr<>Nil) then CloseScreen(Scr);
+  if GfxBase <> nil then CloseLibrary(GfxBase);
+  if str <> '' then writeln(str);
+  Halt(code);
+END;
+
+
+PROCEDURE Init;
+var
+  thetags : array[0..3] of tTagItem;
+
+BEGIN
+  GfxBase := OpenLibrary(GRAPHICSNAME,0);
+  if GfxBase = nil then CleanUp('no graphics.library',20);
+
+  Scr:=Nil;  Win:=Nil;
+
+  thetags[0] := TagItem(SA_Depth,     3);
+  thetags[1] := TagItem(SA_DisplayID, HIRES_KEY);
+  thetags[2].ti_Tag := TAG_END;
+
+  Scr := OpenScreenTagList(NIL,@thetags);
+  If Scr=Nil Then CleanUp('No screen',20);
+
+  thetags[0] := TagItem(WA_Flags, WFLG_BORDERLESS);
+  thetags[1] := TagItem(WA_IDCMP, IDCMP_MOUSEBUTTONS);
+  thetags[2] := TagItem(WA_CustomScreen, Longint(Scr));
+  thetags[3].ti_Tag := TAG_DONE;
+
+  Win:=OpenWindowTagList(Nil, @thetags);
+  If Win=Nil Then CleanUp('No window',20);
+
+  initSterne;
+
+  SetRGB4(@Scr^.ViewPort, 0, $0,$0,$0);
+  SetRGB4(@Scr^.ViewPort, 1, $3,$3,$3);
+  SetRGB4(@Scr^.ViewPort, 2, $6,$6,$6);
+  SetRGB4(@Scr^.ViewPort, 3, $b,$b,$b);
+  SetRGB4(@Scr^.ViewPort, 4, $c,$c,$c);
+  SetRGB4(@Scr^.ViewPort, 5, $d,$d,$d);
+  SetRGB4(@Scr^.ViewPort, 6, $e,$e,$e);
+  SetRGB4(@Scr^.ViewPort, 7, $f,$f,$f);
+
+END;
+
+
+
+BEGIN
+  Init;
+  Ende:=false;
+  Repeat
+    drawSterne;
+    Msg:=pIntuiMessage(GetMsg(Win^.UserPort));
+    If Msg<>Nil Then Begin
+      ReplyMsg(Pointer(Msg));
+      Ende:=true;
+    End;
+  Until Ende;
+  CleanUp('',0);
+END.
+

packages/extra/amunits/demos/talk2boopsi.pas

@@ -0,0 +1,131 @@
+PROGRAM Talk2Boopsi;
+
+{ This example creates a Boopsi prop gadget and integer string gadget, connecting them so they }
+{ update each other when the user changes their value.  The example program only initializes   }
+{ the gadgets and puts them on the window; it doesn't have to interact with them to make them  }
+{ talk to each other.                                                                          }
+
+uses Exec, Intuition, Utility;
+
+{$I tagutils.inc}
+
+VAR
+   w      : pWindow;
+   mymsg  : pIntuiMessage;
+   prop,
+   int    : pGadget;
+   done   : BOOLEAN;
+   dummy  : Word;
+   temp   : Longint;
+   thetags : array[0..11] of tTagItem;
+   prop2intmap : array[0..1] of tTagItem;
+   int2propmap : array[0..1] of tTagItem;
+
+CONST
+
+   vers  : PChar = '$VER: Talk2boopsi 37.1';
+
+    PROPGADGET_ID       = 1;
+   INTGADGET_ID        = 2;
+   PROPGADGETWIDTH     = 10;
+   PROPGADGETHEIGHT    = 80;
+   INTGADGETHEIGHT     = 18;
+   VISIBLE             = 10;
+   TOTAL               = 100;
+   INITIALVAL          = 25;
+   MINWINDOWWIDTH      = 80;
+   MINWINDOWHEIGHT     = (PROPGADGETHEIGHT + 70);
+   MAXCHARS            = 3;
+
+PROCEDURE CleanUp(Why : STRING; err: Word);
+BEGIN
+    IF prop <> NIL THEN DisposeObject(prop);
+    IF int <> NIL THEN DisposeObject(int);
+    IF w <> NIL THEN CloseWindow(w);
+    IF Why <> '' THEN WriteLN(Why);
+    Halt(err);
+END;
+
+BEGIN
+
+    done := FALSE;
+
+    prop2intmap[0] := TagItem(PGA_Top, STRINGA_LongVal);
+    prop2intmap[1].ti_Tag := TAG_END;
+
+    int2propmap[0] := TagItem(STRINGA_LongVal, PGA_Top);
+    int2propmap[1].ti_Tag := TAG_END;
+
+    thetags[0] := TagItem(WA_Flags,     WFLG_DEPTHGADGET + WFLG_DRAGBAR +
+                               WFLG_CLOSEGADGET + WFLG_SIZEGADGET + WFLG_ACTIVATE);
+    thetags[1] := TagItem(WA_IDCMP,     IDCMP_CLOSEWINDOW);
+    thetags[2] := TagItem(WA_Width,     MINWINDOWWIDTH + 10);
+    thetags[3] := TagItem(WA_Height,    MINWINDOWHEIGHT + 10);
+    thetags[4] := TagItem(WA_MinWidth,  MINWINDOWWIDTH);
+    thetags[5] := TagItem(WA_MinHeight, MINWINDOWHEIGHT);
+    thetags[6].ti_Tag := TAG_END;
+
+    w := OpenWindowTagList(NIL,@thetags);
+
+    IF w=NIL THEN CleanUp('No window',20);
+
+    thetags[0] := TagItem(GA_ID,       PROPGADGET_ID);
+    thetags[1] := TagItem(GA_Top,      (w^.BorderTop) + 5);
+    thetags[2] := TagItem(GA_Left,     (w^.BorderLeft) + 5);
+    thetags[3] := TagItem(GA_Width,    PROPGADGETWIDTH);
+    thetags[4] := TagItem(GA_Height,   PROPGADGETHEIGHT);
+    thetags[5] := TagItem(ICA_MAP,     Longint(@prop2intmap));
+    thetags[6] := TagItem(PGA_Total,   TOTAL);
+    thetags[7] := TagItem(PGA_Top,     INITIALVAL);
+    thetags[8] := TagItem(PGA_Visible, VISIBLE);
+    thetags[9] := TagItem(PGA_NewLook, 1); { true }
+    thetags[10].ti_Tag := TAG_END;
+
+    prop := NewObjectA(NIL, PChar('propgclass'#0),@thetags);
+
+    IF prop = NIL THEN CleanUp('No propgadget',20);
+
+
+    thetags[0] := TagItem(GA_ID,      INTGADGET_ID);
+    thetags[2] := TagItem(GA_Top,     (w^.BorderTop) + 5);
+    thetags[3] := TagItem(GA_Left,    (w^.BorderLeft) + PROPGADGETWIDTH + 10);
+    thetags[4] := TagItem(GA_Width,   MINWINDOWWIDTH -
+                                  (w^.BorderLeft + w^.BorderRight +
+                                  PROPGADGETWIDTH + 15));
+    thetags[5] := TagItem(GA_Height,  INTGADGETHEIGHT);
+
+    thetags[6] := TagItem(ICA_MAP,    Longint(@int2propmap));
+    thetags[7] := TagItem(ICA_TARGET, Longint(prop));
+    thetags[8] := TagItem(GA_Previous, Longint(prop));
+
+    thetags[9] := TagItem(STRINGA_LongVal,  INITIALVAL);
+    thetags[10] := TagItem(STRINGA_MaxChars, MAXCHARS);
+    thetags[11].ti_Tag := TAG_END;
+
+    int := NewObjectA(NIL, PChar('strgclass'#0),@thetags);
+
+    thetags[0] := TagItem(ICA_TARGET, Longint(int));
+    thetags[1].ti_Tag := TAG_END;
+
+    temp := SetGadgetAttrsA(prop, w, NIL,@thetags);
+
+    IF int = NIL THEN CleanUp('No INTEGER gadget',20);
+
+    dummy := AddGList(w, prop, -1, -1, NIL);
+    RefreshGList(prop, w, NIL, -1);
+
+    WHILE (NOT done) DO BEGIN
+        mymsg := pIntuiMessage(WaitPort(W^.UserPort));
+        mymsg := pIntuiMessage(GetMsg(W^.UserPort));
+        IF mymsg^.IClass = IDCMP_CLOSEWINDOW THEN done := True;
+        ReplyMsg(pMessage(mymsg));
+    END;
+
+    dummy := RemoveGList(w, prop, -1);
+    CleanUp('',0);
+END.
+
+
+
+
+

packages/extra/amunits/inc/tagutils.inc

@@ -0,0 +1,26 @@
+
+{
+   tagutils.inc
+
+   Some handy functions to deal with taglist.
+   At least until fpc have array of const.
+}
+
+procedure SetTags(ti : pTagItem; item, data : Longint);
+begin
+    with ti^ do begin
+       ti_Tag := item;
+       ti_Data := data;
+    end;
+end;
+
+function TagItem(item, data : Longint): tTagItem;
+var
+   temp : tTagItem;
+begin
+   with temp do begin
+      ti_Tag := item;
+      ti_Data := data;
+   end;
+   TagItem := temp;
+end;

packages/extra/amunits/rexx/getrecord.rexx

@@ -0,0 +1,157 @@
+/* getrecord.rexx
+
+   This is a rexxscript to scan for pascal records.
+
+   I made this one to check my translation of
+   cheaders to fpc units. It will write two
+   files one pascalfile and one cfile.
+
+   The pascalfile you can almost everytime just
+   compile with fpc. In the cfile you have to
+   make some changes, just put in a line that
+   include the cheader for you testprogram.
+
+   So if you translate a cheader to fpc just
+   let this script check it out, if you get
+   the same result from both program you have
+   probably made the translation correct.
+
+   Usage:
+
+   rx getrecord yourunit.pas
+
+   [email protected]
+
+*/
+
+
+SIGNAL ON BREAK_C
+SIGNAL ON SYNTAX
+
+parse arg name
+
+if name = '' then do
+   say 'Input filename to scan for records'
+   parse pull name end
+   if name = '' then do
+   say 'Error no filename'
+   exit 20
+   end
+   end
+
+k = 1
+
+thesource = name
+
+if index(name,'.') > 0 then do
+parse var name thesource '.' extension
+end
+
+pasname = thesource || 'rec1.pas'
+cname = thesource || 'rec2.c'
+
+IF ~Open('textfile',name,'READ') THEN DO
+    say 'File not found'
+    exit 20
+end
+else do
+  say 'Scanning ' || name
+  i = 1
+  DO WHILE ~eof('textfile')
+     line.i = ReadLn('textfile')
+     line.i = Strip(line.i)
+     myproc = Word(line.i,3)
+     myproc = Upper(myproc)
+     IF myproc = "RECORD" THEN DO
+        CALL CheckLine(line.i)
+        SAY "Doing line :" || i
+     END
+     i = i +1
+  END
+  CALL Close('textfile')
+  if k > 1 then do
+     call writepasfile
+     call writecfile
+     say 'Done'
+  end
+  else say 'No records found'
+END
+EXIT
+
+pasheader:
+       writeln('outfile','Program testrecords;')
+       writeln('outfile','')
+       writeln('outfile','uses exec,' || thesource || ';')
+       writeln('outfile','')
+       writeln('outfile','begin')
+return
+
+writepasfile:
+    if ~Open('outfile',pasname,'W') then do
+    say 'Can not create file'
+    exit 20
+    end
+    else do
+    SAY "Working on " || pasname
+    call pasheader
+    do j = 1 to k-1
+    thename = record.j
+    towrite = 'writeln(' || "'" || thename || "',' ':30-length(" || "'" ||thename || "'),"
+    towrite = towrite || "':'"
+    towrite = towrite || ',sizeof(' || thename || '));'
+
+    writeln('outfile',towrite)
+    end j
+    writeln('outfile','end.')
+    writeln('outfile','')
+    CALL Close('outfile')
+
+RETURN
+
+cheader:
+    writeln('outfile','');
+    writeln('outfile','#include ' || '"stdio.h"')
+    writeln('outfile','')
+    writeln('outfile','main()')
+    writeln('outfile','{')
+    return
+
+writecfile:
+    if ~Open('outfile',cname,'W') then do
+    say 'Can not create file'
+    exit 20
+    end
+    else do
+    SAY "Working on " || cname
+    call cheader
+    do j = 1 to k-1
+    thename = record.j
+    towrite = 'printf(' || '"%-30s:%d\n","' || thename || '",'
+    towrite = towrite || 'sizeof(struct ' || right(thename,length(thename)-1) ||'));'
+
+    writeln('outfile',towrite)
+    end j
+    writeln('outfile','}')
+    writeln('outfile','')
+
+    CALL Close('outfile')
+return
+
+CheckLine:
+    PARSE ARG theline
+    parse var theline thename thesep therecord therest
+    if thesep = '=' then do
+    thename = strip(thename)
+    record.k = thename
+    k = k +1
+    end
+RETURN
+
+
+
+BREAK_C:
+SYNTAX:
+SAY "Sorry, error line" SIGL ":" ErrorText(RC) ":-("
+EXIT
+
+

packages/extra/amunits/rexx/make.rexx

@@ -0,0 +1,148 @@
+/*
+
+  A simple make script for FPC Pascal.
+
+  For your final release you can use this script
+  to get the smallest possible program.
+
+  If you are using the ms-dos cross compiler you
+  can use this script to assemble and link your
+  programs.
+  This is what I started with, compiled all units
+  on ms-dos and moved them over to my Amiga. There
+  I assembled all to objectfiles. Now I could
+  compile testprograms on ms-dos, move to Amiga
+  and use this script to put it all together.
+
+  Usage:
+
+  rx make testprog.pas exec intuition graphics
+
+  This will compile testprog.pas and link
+  prt0.o, sysamiga.o, exec.o, intuition.o,
+  graphics.o and testprog.o to testprog.
+
+  rx make testprog.asm exec intuition graphics
+
+  The same as above but it just assembles
+  testprog.asm and links it.
+
+  rx make testprog exec intuition graphics
+
+  The same as above, treats testprog as an
+  assembler file.
+
+
+  Don't forget so set the correct paths for
+  the binaries bellow.
+
+  This is just a quick hack but it does work.
+
+  [email protected]
+
+*/
+
+SIGNAL ON BREAK_C
+SIGNAL ON SYNTAX
+
+
+parse arg main list
+
+/*
+  First parse the args and set up a list
+*/
+
+k = 0           œ
+do while list ~= ''
+parse var list keyword.k list
+k=k+1
+end
+
+/*
+  Set the correct path
+*/
+
+ASCOM    = 'dh1:fpc/bin/as'
+LDCOM    = 'dh1:fpc/bin/ld'
+UNITS    = 'dh1:fpc/units/'
+SYSUNITS = 'dh1:fpc/lib/'
+PPCCOM   = 'dh1:fpc/bin/ppc'
+STRIPCOM = 'dh1:fpc/bin/strip'
+
+/*
+  Set the system units in the list
+*/
+
+linkline = SYSUNITS || 'prt0.o ' || SYSUNITS || 'sysamiga.o '
+
+/*
+  If there are more args, put in linklist
+*/
+
+do n=0 to k-1
+linkline = linkline || UNITS || keyword.n || '.o'||' '
+end
+
+/*
+  Check if it's  a pascal or assembler file
+*/
+
+parse var main head '.' ext
+if upper(ext) = 'PAS' | upper(ext) = 'P' | upper(ext) = 'PP'  then do
+   say 'Compiling ' || main
+   address command PPCCOM || ' ' main || ' -Cn'
+   if rc ~=0 then do
+     say 'Problems with compiler'
+     exit
+   end
+end
+else do
+   parse var main head '.' ext
+   say 'Assembling ' || head
+   address command ASCOM || ' ' || head || '.asm' || ' -o ' || head || '.o'
+   if rc ~=0 then do
+     say 'Problems with assembler'
+   exit
+   end
+end
+
+/*
+  If we got here add to linklist
+*/
+
+linkline = linkline || head || '.o' || ' -o ' || head
+
+/*
+  Now link the files
+*/
+
+say 'Linking ' || head
+address command LDCOM || ' ' || linkline
+if rc ~=0 then do
+  say 'Problems with linker'
+  exit
+  end
+
+/*
+  Use strip
+*/
+
+say 'Using Strip on ' || head
+address command STRIPCOM || ' ' || head
+if rc ~=0 then do
+  say 'Problems with strip'
+  exit
+  end
+
+say 'Done with ' || head
+exit
+
+BREAK_C:
+SYNTAX:
+SAY "Sorry, error line" SIGL ":" ErrorText(RC) ":-("
+EXIT
+
+
+
+
+

packages/extra/amunits/units.txt

@@ -0,0 +1,57 @@
+
+
+    Amiga units for fpc.
+
+    There should not be any problems to use
+    this units in Amiga or in linux.
+
+    For the ms-dos cross-compiler you have to
+    do some changes.
+
+    First you have to rename the units to 8.3
+    e.g intuition.pas to intuitio.pas
+    No need to change in the units the compiler
+    will find the units anyway.
+
+    There are a few you will have problems with,
+    expansion.pas and expansionbase.pas. What
+    you can do is to rename them to expan.pas
+    and expanbas.pas. If a unit uses the old
+    name the compiler will complain so just
+    fix that unit when the problems pops up.
+
+    The same problem with configregs.pas and
+    configvars.pas, perhaps do cfgvars.pas and
+    cfgregs.pas
+
+    If you find any bugs or errors in the units
+    please inform me. Address bellow.
+
+    If you want do translate other libraries to
+    fpc use Fd2Pragma, it's on Aminet. Read the
+    docs for Fd2Pragma on how to make units
+    for fpc. Fd2Pragma translates almost everything
+    correct for fpc. There is one thing you have to
+    do to the new unit, make a search/replace for
+    Cardinal/ULONG. Fpc for Amiga don't handle
+    Cardinals in this version (later), so we have
+    to use ULONG instead. ULONG is typedefed as
+    Longint (in Exec) in a new version of fpc
+    we just have to typedef ULONG as Cardinal.
+    What's left is for you to translate structs
+    and defines.:)
+
+    There are also two rexx scripts that can be
+    handy, getrecord.rexx and make.rexx. You can
+    use getrecord.rexx to check that you have
+    translated the structs correct. Read more
+    in the scripts headers.
+
+
+    Other than that just have fun!
+
+
+    [email protected]
+
+
+