* update check internal log

packages/extra/amunits/units/amigalib.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -14,11 +14,45 @@
 
  **********************************************************************}
 
+{
+    History:
+
+    Added DoMethodA, DoSuperMethodA, CoerceMethodA and SetSuperAttrsA.
+
+    I've translated those from amigae. I'm not sure that they are
+    correct but it's a start. Now you can try to make some tests
+    with mui.
+    30 Jul 2000.
+
+    Added stuff for commodities.
+    FreeIEvents
+    CxCustom
+    CxDebug
+    CxFilter
+    CxSender
+    CxSignal
+    CxTranslate
+    19 Aug 2000.
+
+    Rewrote Createport and DeletePort.
+    06 Sep 2000.
+
+    Added two printf, one with pchar and one with string.
+    They use array of const so this unit compiles with
+    mode objfpc.
+
+    05 Nov 2002.
+
+    [email protected]
+}
+
 unit amigalib;
 
+{$mode objfpc}
+
 INTERFACE
 
-uses exec;
+uses exec,intuition,utility,commodities,inputevent,amigados;
 
 {*  Exec support functions from amiga.lib  *}
 
@@ -27,7 +61,7 @@ function CreateExtIO (port: pMsgPort; size: Longint): pIORequest;
 procedure DeleteExtIO (ioReq: pIORequest);
 function CreateStdIO (port: pMsgPort): pIOStdReq;
 procedure DeleteStdIO (ioReq: pIOStdReq);
-function CreatePort (name: STRPTR; pri: integer): pMsgPort;
+function CreatePort (name: PChar; pri: longint): pMsgPort;
 procedure DeletePort (port: pMsgPort);
 function CreateTask (name: STRPTR; pri: longint;
                      initPC : Pointer;
@@ -35,8 +69,96 @@ function CreateTask (name: STRPTR; pri: longint;
 procedure DeleteTask (task: pTask);
 procedure NewList (list: pList);
 
+{* Commodities support functions from amiga.lib *}
+procedure FreeIEvents (events: pInputEvent);
+function CxCustom
+		(action: pointer;
+		id: longint): pCxObj;
+
+function CxDebug (id: long): pCxObj;
+function CxFilter (d: STRPTR): pCxObj;
+function CxSender
+		(port: pMsgPort;
+		id: longint): pCxObj;
+
+function CxSignal
+		(task: pTask;
+		sig: byte): pCxObj;
+
+function CxTranslate (ie: pInputEvent): pCxObj;
+
+
+function DoMethodA(obj : pObject_; msg : APTR): ulong;
+function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
+function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
+function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong;
+
+{
+
+   NAME
+        printf - print a formatted output line to the standard output.
+
+   SYNOPSIS
+        printf(formatstring [,value [,values] ] );
+
+   FUNCTION
+        Format the output in accordance with specifications in the format
+        string.
+
+   INPUTS
+        formatString - a C-language-like NULL-terminated format string,
+                       with the following supported % options:
+
+          %[flags][width][.limit][length]type
+
+            $     - must follow the arg_pos value, if specified
+          flags   - only one allowed. '-' specifies left justification.
+          width   - field width. If the first character is a '0', the
+                    field is padded with leading 0s.
+            .     - must precede the field width value, if specified
+          limit   - maximum number of characters to output from a string.
+                    (only valid for %s or %b).
+          length  - size of input data defaults to word (16-bit) for types c,
+                    d, u and x, 'l' changes this to long (32-bit).
+          type    - supported types are:
+                          b - BSTR, data is 32-bit BPTR to byte count followed
+                              by a byte string. A NULL BPTR is treated as an
+                              empty string. (V36)
+                          d - signed decimal
+                          u - unsigned decimal
+                          x - hexadecimal with hex digits in uppercase
+                          X - hexadecimal with hex digits in lowercase
+                          s - string, a 32-bit pointer to a NULL-terminated
+                              byte string. A NULL pointer is treated
+                              as an empty string.
+                          c - character
+
+        value(s) - numeric variables or addresses of null-terminated strings
+                   to be added to the format information.
+
+   NOTE
+        The global "_stdout" must be defined, and contain a pointer to
+        a legal AmigaDOS file handle. Using the standard Amiga startup
+        module sets this up. In other cases you will need to define
+        stdout, and assign it to some reasonable value (like what the
+        dos.library/Output() call returns). This code would set it up:
+
+                ULONG stdout;
+                stdout=Output();
+
+   BUGS
+        This function will crash if the resulting stream after
+        parameter substitution is longer than 140 bytes.
+
+}
+
+procedure printf(Fmtstr : pchar; Args : array of const);
+procedure printf(Fmtstr : string; Args : array of const);
+
 IMPLEMENTATION
 
+uses pastoc;
+
 {*  Exec support functions from amiga.lib  *}
 
 procedure BeginIO (ioRequest: pIORequest);
@@ -93,38 +215,33 @@ begin
 end;
 
 
-function CreatePort (name: STRPTR; pri: integer): pMsgPort;
+function Createport(name : PChar; pri : longint): pMsgPort;
 var
-   port   : pMsgPort;
-   sigbit : shortint;
+   sigbit : Byte;
+   port    : pMsgPort;
 begin
-    port  := NIL;
-    sigbit := AllocSignal(-1);
-    if sigbit <> -1 then
-    begin
-        port := AllocMem(sizeof(tMsgPort), MEMF_CLEAR or MEMF_PUBLIC);
-        if port = NIL then
-            FreeSignal(sigbit)
-        else
-            begin
-                port^.mp_Node.ln_Name  := name;
-                port^.mp_Node.ln_Pri   := pri;
-                port^.mp_Node.ln_Type  := NT_MSGPORT;
-
-                port^.mp_Flags    := PA_SIGNAL;
-                port^.mp_SigBit   := sigbit;
-                port^.mp_SigTask  := FindTask(NIL);
-
-                if name <> NIL then
-                    AddPort(port)
-                else
-                    NewList(@port^.mp_MsgList);
-            end;
-    end;
-    CreatePort := port;
+   sigbit := AllocSignal(-1);
+   if sigbit = -1 then CreatePort := nil;
+   port := Allocmem(sizeof(tMsgPort),MEMF_CLEAR or MEMF_PUBLIC);
+   if port = nil then begin
+      FreeSignal(sigbit);
+      CreatePort := nil;
+   end;
+   with port^ do begin
+       if assigned(name) then
+       mp_Node.ln_Name := name
+       else mp_Node.ln_Name := nil;
+       mp_Node.ln_Pri := pri;
+       mp_Node.ln_Type := NT_MsgPort;
+       mp_Flags := PA_Signal;
+       mp_SigBit := sigbit;
+       mp_SigTask := FindTask(nil);
+   end;
+   if assigned(name) then AddPort(port)
+   else NewList(addr(port^.mp_MsgList));
+   CreatePort := port;
 end;
 
-
 procedure DeletePort (port: pMsgPort);
 begin
     if port <> NIL then
@@ -132,7 +249,7 @@ begin
         if port^.mp_Node.ln_Name <> NIL then
             RemPort(port);
 
-        port^.mp_SigTask       := pTask(-1);
+        port^.mp_Node.ln_Type     := $FF;
         port^.mp_MsgList.lh_Head  := pNode(-1);
         FreeSignal(port^.mp_SigBit);
         ExecFreeMem(port, sizeof(tMsgPort));
@@ -190,6 +307,123 @@ begin
     end
 end;
 
+procedure FreeIEvents (events: pInputEvent);
+begin
+	while events <> NIL do
+	begin
+		FreeMem (events, sizeof (tInputEvent));
+		events := events^.ie_NextEvent
+	end
+end;
+
+function CxCustom
+		(action: pointer;
+		id: longint): pCxObj;
+begin
+	CxCustom := CreateCxObj(CX_CUSTOM, longint(action), id)
+end;
+
+function CxDebug (id: long): pCxObj;
+begin
+	CxDebug := CreateCxObj(CX_DEBUG, id, 0)
+end;
+
+function CxFilter (d: STRPTR): pCxObj;
+begin
+	CxFilter := CreateCxObj(CX_FILTER, longint(d), 0)
+end;
+
+function CxSender
+		(port: pMsgPort;
+		id: longint): pCxObj;
+begin
+	CxSender := CreateCxObj(CX_SEND, longint(port), id)
+end;
+
+function CxSignal
+		(task: pTask;
+		sig: byte): pCxObj;
+begin
+	CxSignal:= CreateCxObj(CX_SIGNAL, longint(task), sig)
+end;
+
+function CxTranslate (ie: pInputEvent): pCxObj;
+begin
+	CxTranslate := CreateCxObj(CX_TRANSLATE, longint(ie), 0)
+end;
+
+function DoMethodA(obj : pObject_; msg : APTR): ulong;
+var
+    o : p_Object;
+begin
+    if assigned(obj) then begin
+       o := p_Object(obj);
+       DoMethodA := CallHookPkt(@o^.o_Class^.cl_Dispatcher, obj,msg);
+    end else DoMethodA := 0;
+end;
+
+function DoSuperMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
+begin
+    if assigned(obj) and assigned(cl) then
+       DoSuperMethodA := CallHookPkt(@cl^.cl_Super^.cl_Dispatcher,obj,msg)
+    else DoSuperMethodA := 0;
+end;
+
+function CoerceMethodA(cl : pIClass; obj : pObject_; msg : APTR): ulong;
+begin
+    if assigned(cl) and assigned(obj) then
+       CoerceMethodA := CallHookPkt(@cl^.cl_Dispatcher,obj,msg)
+    else CoerceMethodA := 0;
+end;
+
+function SetSuperAttrsA(cl : pIClass; obj: pObject_; msg : APTR): ulong;
+var
+    arr : array[0..2] of longint;
+begin
+    arr[0] := OM_SET;
+    arr[1] := longint(msg);
+    arr[2] := 0;
+    SetSuperAttrsA := DoSuperMethodA(cl, obj, @arr);
+end;
+
+var
+  argarray : array [0..20] of longint;
+
+function gettheconst(args : array of const): pointer;
+var
+   i : longint;
+
+begin
+
+    for i := 0 to High(args) do begin
+        case args[i].vtype of
+	    vtinteger : argarray[i] := longint(args[i].vinteger);
+	    vtpchar   : argarray[i] := longint(args[i].vpchar);
+	    vtchar    : argarray[i] := longint(args[i].vchar);
+	    vtpointer : argarray[i] := longint(args[i].vpointer);
+	    vtstring  : argarray[i] := longint(pas2c(args[i].vstring^));
+        end;
+    end;
+    gettheconst := @argarray;
+end;
+
+procedure printf(Fmtstr : pchar; Args : array of const);
+begin
+    VPrintf(Fmtstr,gettheconst(Args));
+end;
+
+procedure printf(Fmtstr : string; Args : array of const);
+begin
+    VPrintf(pas2c(Fmtstr) ,gettheconst(Args));
+end;
+
+
 end.
 
 
+{
+  $Log$
+  Revision 1.3  2002-11-18 20:50:18  nils
+    * update check internal log
+
+}

packages/extra/amunits/units/asl.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -14,6 +14,27 @@
 
  **********************************************************************}
 
+{
+    History:
+
+    Found a bug in tFileRequester, rt_ArgList had pWBArg as arg
+    should be pWBArgList. Fixed
+    27 Oct 1998.
+
+    Added autoopening of asl.library.
+    28 Oct 1998.
+
+    Added MessageBox for error report.
+    31 Jul 2000.
+
+    Added functions and procedures with array of const.
+    For use with fpc 1.0.7 They are in systemvartags.
+    11 Nov 2002.
+    
+    [email protected]
+}
+
+
 UNIT asl;
 
 INTERFACE
@@ -56,7 +77,7 @@ Type
            rf_Height      : Integer;          { Preferred window size  }
            rf_Reserved2   : Array[0..1] Of Byte;
            rf_NumArgs     : LongInt;       { A-la WB Args, FOR multiselects }
-           rf_ArgList     : pWBArg
+           rf_ArgList     : pWBArgList;
            rf_UserData    : Pointer;       { Applihandle (you may write!!) }
            rf_Reserved3   : Array[0..7] Of Byte;
            rf_Pat         : STRPTR;        { Pattern match pointer }
@@ -408,6 +429,7 @@ Const
 
 
 VAR AslBase : pLibrary;
+   
 
 FUNCTION AllocAslRequest(reqType : ULONG; tagList : pTagItem) : POINTER;
 FUNCTION AllocFileRequest : pFileRequester;
@@ -416,8 +438,11 @@ PROCEDURE FreeAslRequest(requester : POINTER);
 PROCEDURE FreeFileRequest(fileReq : pFileRequester);
 FUNCTION RequestFile(fileReq : pFileRequester) : BOOLEAN;
 
+
 IMPLEMENTATION
 
+uses msgbox;
+
 FUNCTION AllocAslRequest(reqType : ULONG; tagList : pTagItem) : POINTER;
 BEGIN
   ASM
@@ -495,4 +520,43 @@ BEGIN
   END;
 END;
 
+var
+    asl_exit : Pointer;
+
+procedure CloseAslLibrary;
+begin
+    ExitProc := asl_exit;
+    if AslBase <> nil then begin
+       CloseLibrary(AslBase);
+       AslBase := nil;
+    end;
+end;
+
+const
+    VERSION : string[2] = '37';
+
+begin
+    AslBase := nil;
+    AslBase := OpenLibrary(ASLNAME,37);
+    if AslBase <> nil then begin
+       asl_exit := ExitProc;
+       ExitProc := @CloseAslLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+                   'Can''t open asl.library version ' +
+                   VERSION +
+                   chr(10) + 
+                   'Deallocating resources and closing down',
+                   'Oops');
+       halt(20);
+    end;
+
 END. (* UNIT ASL *)
+
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:50:45  nils
+    * update check internal log
+
+}
+  

packages/extra/amunits/units/commodities.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -13,14 +13,24 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{
+    History:
+    Added overlay functions for Pchar->Strings, functions
+    and procedures.
+
+    14 Jul 2000.
+    [email protected]
+}
 
 unit commodities;
 
 INTERFACE
 
+
 uses exec, inputevent, keymap;
 
 
+
 {    **************
  * Broker stuff
  **************}
@@ -234,8 +244,16 @@ PROCEDURE SetFilter(filter : pCxObj; text : pCHAR);
 PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression);
 PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent);
 
+{ overlay functions}
+
+FUNCTION ParseIX(description : string; ix : pInputXpression) : LONGINT;
+PROCEDURE SetFilter(filter : pCxObj; text : string);
+
+
 IMPLEMENTATION
 
+uses pastoc;
+
 FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT;
 BEGIN
   ASM
@@ -559,7 +577,25 @@ BEGIN
   END;
 END;
 
+
+FUNCTION ParseIX(description : string; ix : pInputXpression) : LONGINT;
+begin
+      ParseIX := ParseIX(pas2c(description),ix);
+end;
+
+PROCEDURE SetFilter(filter : pCxObj; text : string);
+begin
+      SetFilter(filter,pas2c(text));
+end;
+
+
 END. (* UNIT COMMODITIES *)
 
 
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:52:02  nils
+    * update check internal log
 
+}
+  

packages/extra/amunits/units/datatypes.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -14,6 +14,16 @@
 
  **********************************************************************}
 
+{
+    History:
+
+    Added functions and procedures with array of const.
+    For use with fpc 1.0.7. Thay are in systemvartags.
+    11 Nov 2001.
+    
+    [email protected]
+}
+
 unit datatypes;
 
 INTERFACE
@@ -1067,6 +1077,7 @@ PROCEDURE ReleaseDataType(dt : pDataType);
 FUNCTION RemoveDTObject(win : pWindow; o : pObject_) : LONGINT;
 FUNCTION SetDTAttrsA(o : pObject_; win : pWindow; req : pRequester; attrs : pTagItem) : ULONG;
 
+
 IMPLEMENTATION
 
 FUNCTION AddDTObject(win : pWindow; req : pRequester; o : pObject_; pos : LONGINT) : LONGINT;
@@ -1270,5 +1281,12 @@ END;
 END. (* UNIT DATATYPES *)
 
 
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:52:28  nils
+    * update check internal log
+
+}
 
+  
 

packages/extra/amunits/units/expansionbase.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -13,6 +13,14 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{
+    History:
+    
+    Typo in ExpansionBase Record.
+    11 Nov. 2002
+    
+    [email protected]
+}    
 
 
 unit expansionbase;
@@ -44,7 +52,7 @@ Type
         Flags           : Byte;
         eb_Private01    : Byte;
         eb_Private02    : ULONG;
-        eb_Private02    : ULONG;
+        eb_Private03    : ULONG;
         eb_Private04    : tCurrentBinding;
         eb_Private05    : tList;
         MountList       : tList;
@@ -87,7 +95,14 @@ IMPLEMENTATION
 
 end.
 
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:53:16  nils
+    * update check internal log
+
+}
 
+  
 
 
 

packages/extra/amunits/units/gadtools.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -13,6 +13,25 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{
+    History:
+
+    Added autoopening of gadtools.library.
+    15 Jul 2000.
+
+    Added MessageBox for error report.
+    31 Jul 2000.
+
+    Added the macros GTMENUITEM_USERDATA and GTMENU_USERDATA.
+    19 Aug 2000.
+
+    Added functions and procedures with array of const.
+    For use with fpc 1.0. They are in systemvartags.
+    11 Nov 2002.
+
+    [email protected]
+
+}
 
 unit gadtools;
 
@@ -45,7 +64,7 @@ CONST
  NUM_KINDS     =  14;
 
  GADTOOLSNAME   : PChar = 'gadtools.library';
-
+ 
 
 {------------------------------------------------------------------------}
 
@@ -455,8 +474,23 @@ PROCEDURE GT_SetGadgetAttrsA(gad : pGadget; win : pWindow; req : pRequester; tag
 FUNCTION LayoutMenuItemsA(firstitem : pMenuItem; vi : POINTER; taglist : pTagItem) : BOOLEAN;
 FUNCTION LayoutMenusA(firstmenu : pMenu; vi : POINTER; taglist : pTagItem) : BOOLEAN;
 
+function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
+function GTMENU_USERDATA(menu : pMenu): pointer;
+
 IMPLEMENTATION
 
+uses msgbox;
+
+function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
+begin
+    GTMENUITEM_USERDATA := pointer((pMenuItem(menuitem)+1));
+end;
+
+function GTMENU_USERDATA(menu : pMenu): pointer;
+begin
+    GTMENU_USERDATA := pointer((pMenu(menu)+1));
+end;
+
 FUNCTION CreateContext(glistptr : pGadget): pGadget;
 BEGIN
   ASM
@@ -704,7 +738,45 @@ BEGIN
   END;
 END;
 
+var
+  gadtools_exit : Pointer;
+
+procedure CloseGadToolsLibrary;
+begin
+    ExitProc := gadtools_exit;
+    if GadToolsBase <> nil then begin
+        CloseLibrary(GadToolsBase);
+        GadToolsBase := nil;
+    end;
+end;
+
+const
+   VERSION        : string[2] = '37';
+   LIBVERSION     = 37;
+
+begin
+    GadToolsBase := nil;
+    GadToolsBase := OpenLibrary(GADTOOLSNAME,LIBVERSION);
+    if GadToolsBase <> nil then begin
+         gadtools_Exit := ExitProc;
+         ExitProc := @CloseGadToolsLibrary;
+    end else begin
+         MessageBox('FPC Pascal Error',
+                    'Can''t open gadtools.library version ' + 
+                    VERSION +
+                    chr(10) + 
+                    'Deallocating resources and closing down',
+                    'Oops');
+         halt(20);
+    end;
 END. (* UNIT GADTOOLS *)
 
 
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:53:34  nils
+    * update check internal log
+
+}
 
+  

packages/extra/amunits/units/graphics.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -14,6 +14,34 @@
 
  **********************************************************************}
 
+ {
+    History:
+
+    Found bugs in,
+    WritePixelArray8,
+    WritePixelLine8,
+    ReadPixelArray8,
+    ReadPixelLine8,
+    WriteChunkyPixels.
+    They all had one argument(array_) defined as pchar,
+    should be pointer, fixed.
+    20 Aug 2000.
+
+    InitTmpRas had wrong define for the buffer arg.
+    Changed from pchar to PLANEPTR.
+    23 Aug 2000.
+
+    Compiler had problems with Text, changed to GText.
+    24 Aug 2000.
+    
+    Added functions and procedures with array of const.
+    For use with fpc 1.0.7. They are in systemvartags.
+    11 Nov 2002.
+
+    [email protected]
+
+}
+
 unit graphics;
 
 INTERFACE
@@ -2282,7 +2310,7 @@ PROCEDURE InitGels(head : pVSprite; tail : pVSprite; gelsInfo : pGelsInfo);
 PROCEDURE InitGMasks(anOb : pAnimOb);
 PROCEDURE InitMasks(vSprite : pVSprite);
 PROCEDURE InitRastPort(rp : pRastPort);
-FUNCTION InitTmpRas(tmpRas : pTmpRas; buffer : pCHAR; size : LONGINT) : pTmpRas;
+FUNCTION InitTmpRas(tmpRas : pTmpRas; buffer : PLANEPTR; size : LONGINT) : pTmpRas;
 PROCEDURE InitView(view : pView);
 PROCEDURE InitVPort(vp : pViewPort);
 PROCEDURE LoadRGB32(vp : pViewPort; table : POINTER);
@@ -2307,8 +2335,8 @@ PROCEDURE PolyDraw(rp : pRastPort; count : LONGINT; polyTable : POINTER);
 PROCEDURE QBlit(blit : pbltnode);
 PROCEDURE QBSBlit(blit : pbltnode);
 FUNCTION ReadPixel(rp : pRastPort; x : LONGINT; y : LONGINT) : ULONG;
-FUNCTION ReadPixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pCHAR; temprp : pRastPort) : LONGINT;
-FUNCTION ReadPixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pCHAR; tempRP : pRastPort) : LONGINT;
+FUNCTION ReadPixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pointer; temprp : pRastPort) : LONGINT;
+FUNCTION ReadPixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pointer; tempRP : pRastPort) : LONGINT;
 PROCEDURE RectFill(rp : pRastPort; xMin : LONGINT; yMin : LONGINT; xMax : LONGINT; yMax : LONGINT);
 PROCEDURE ReleasePen(cm : pColorMap; n : ULONG);
 PROCEDURE RemFont(textFont : pTextFont);
@@ -2338,8 +2366,8 @@ FUNCTION SetWriteMask(rp : pRastPort; msk : ULONG) : ULONG;
 PROCEDURE SortGList(rp : pRastPort);
 PROCEDURE StripFont(font : pTextFont);
 PROCEDURE SyncSBitMap(layer : pLayer);
-FUNCTION Text(rp : pRastPort; string_ : pCHAR; count : ULONG) : LONGINT;
-FUNCTION TextExtent(rp : pRastPort; string_ : pCHAR; count : LONGINT; textExtent : pTextExtent) : INTEGER;
+FUNCTION GText(rp : pRastPort; string_ : pCHAR; count : ULONG) : LONGINT;
+FUNCTION TextExtent(rp : pRastPort; string_ : pCHAR; count : LONGINT; _textExtent : pTextExtent) : INTEGER;
 FUNCTION TextFit(rp : pRastPort; string_ : pCHAR; strLen : ULONG; textExtent : pTextExtent; constrainingExtent : pTextExtent; strDirection : LONGINT; constrainingBitWidth : ULONG; constrainingBitHeight : ULONG) : ULONG;
 FUNCTION TextLength(rp : pRastPort; string_ : pCHAR; count : ULONG) : INTEGER;
 FUNCTION UCopperListInit(uCopList : pUCopList; n : LONGINT) : pCopList;
@@ -2350,10 +2378,10 @@ PROCEDURE WaitBlit;
 PROCEDURE WaitBOVP(vp : pViewPort);
 PROCEDURE WaitTOF;
 FUNCTION WeighTAMatch(reqTextAttr : pTextAttr; targetTextAttr : pTextAttr; targetTags : pTagItem) : INTEGER;
-PROCEDURE WriteChunkyPixels(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pCHAR; bytesperrow : LONGINT);
+PROCEDURE WriteChunkyPixels(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pointer; bytesperrow : LONGINT);
 FUNCTION WritePixel(rp : pRastPort; x : LONGINT; y : LONGINT) : LONGINT;
-FUNCTION WritePixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pCHAR; temprp : pRastPort) : LONGINT;
-FUNCTION WritePixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pCHAR; tempRP : pRastPort) : LONGINT;
+FUNCTION WritePixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pointer; temprp : pRastPort) : LONGINT;
+FUNCTION WritePixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pointer; tempRP : pRastPort) : LONGINT;
 FUNCTION XorRectRegion(region : pRegion; rectangle : pRectangle) : BOOLEAN;
 FUNCTION XorRegionRegion(srcRegion : pRegion; destRegion : pRegion) : BOOLEAN;
 
@@ -2379,6 +2407,8 @@ PROCEDURE ON_VBLANK (cust: pCustom);
 
 IMPLEMENTATION
 
+uses msgbox;
+
 PROCEDURE BNDRYOFF (w: pRastPort);
 BEGIN
     WITH w^ DO BEGIN
@@ -3641,7 +3671,7 @@ BEGIN
   END;
 END;
 
-FUNCTION InitTmpRas(tmpRas : pTmpRas; buffer : pCHAR; size : LONGINT) : pTmpRas;
+FUNCTION InitTmpRas(tmpRas : pTmpRas; buffer : PLANEPTR; size : LONGINT) : pTmpRas;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -3960,7 +3990,7 @@ BEGIN
   END;
 END;
 
-FUNCTION ReadPixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pCHAR; temprp : pRastPort) : LONGINT;
+FUNCTION ReadPixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pointer; temprp : pRastPort) : LONGINT;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -3978,7 +4008,7 @@ BEGIN
   END;
 END;
 
-FUNCTION ReadPixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pCHAR; tempRP : pRastPort) : LONGINT;
+FUNCTION ReadPixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pointer; tempRP : pRastPort) : LONGINT;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -4373,7 +4403,7 @@ BEGIN
   END;
 END;
 
-FUNCTION Text(rp : pRastPort; string_ : pCHAR; count : ULONG) : LONGINT;
+FUNCTION GText(rp : pRastPort; string_ : pCHAR; count : ULONG) : LONGINT;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -4387,14 +4417,14 @@ BEGIN
   END;
 END;
 
-FUNCTION TextExtent(rp : pRastPort; string_ : pCHAR; count : LONGINT; textExtent : pTextExtent) : INTEGER;
+FUNCTION TextExtent(rp : pRastPort; string_ : pCHAR; count : LONGINT; _textExtent : pTextExtent) : INTEGER;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
     MOVEA.L rp,A1
     MOVEA.L string_,A0
     MOVE.L  count,D0
-    MOVEA.L textExtent,A2
+    MOVEA.L _textExtent,A2
     MOVEA.L GfxBase,A6
     JSR -690(A6)
     MOVEA.L (A7)+,A6
@@ -4531,7 +4561,7 @@ BEGIN
   END;
 END;
 
-PROCEDURE WriteChunkyPixels(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pCHAR; bytesperrow : LONGINT);
+PROCEDURE WriteChunkyPixels(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pointer; bytesperrow : LONGINT);
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -4562,7 +4592,7 @@ BEGIN
   END;
 END;
 
-FUNCTION WritePixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pCHAR; temprp : pRastPort) : LONGINT;
+FUNCTION WritePixelArray8(rp : pRastPort; xstart : ULONG; ystart : ULONG; xstop : ULONG; ystop : ULONG; array_ : pointer; temprp : pRastPort) : LONGINT;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -4580,7 +4610,7 @@ BEGIN
   END;
 END;
 
-FUNCTION WritePixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pCHAR; tempRP : pRastPort) : LONGINT;
+FUNCTION WritePixelLine8(rp : pRastPort; xstart : ULONG; ystart : ULONG; width : ULONG; array_ : pointer; tempRP : pRastPort) : LONGINT;
 BEGIN
   ASM
     MOVE.L  A6,-(A7)
@@ -4629,9 +4659,47 @@ BEGIN
   END;
 END;
 
+var
+    GfxBase_exit : Pointer;
+
+procedure CloseGfxBaseLibrary;
+begin
+    ExitProc := GfxBase_exit;
+    if GfxBase <> nil then begin
+       CloseLibrary(GfxBase);
+       GfxBase := nil;
+    end;
+end;
+
+const
+    VERSION : string[2] = '37';
+
+begin
+    GfxBase := nil;
+    GfxBase := OpenLibrary(GRAPHICSNAME,37);
+    if GfxBase <> nil then begin
+       GfxBase_exit := ExitProc;
+       ExitProc := @CloseGfxBaseLibrary;
+    end else begin
+        MessageBox('FPC Pascal Error',
+                   'Can''t open graphics.library version ' +
+                   VERSION +
+                   chr(10) + 
+                   'Deallocating resources and closing down',
+                   'Oops');
+       halt(20);
+    end;
+
 END. (* UNIT GRAPHICS *)
 
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:54:01  nils
+    * update check internal log
+
+}
 
+  
 
 
 

packages/extra/amunits/units/icon.pas

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
 
     A file in Amiga system run time library.
-    Copyright (c) 1998 by Nils Sjoholm
+    Copyright (c) 1998-2002 by Nils Sjoholm
     member of the Amiga RTL development team.
 
     See the file COPYING.FPC, included in this distribution,
@@ -13,13 +13,25 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{
+    History:
+    Added overlay functions for Pchar->Strings, functions
+    and procedures.
+    14 Jul 2000.
+
+    Removed amigaoverlays, use smartlink instead.
+    05 Nov 2002.
 
+    [email protected]
+}
 unit icon;
 
 INTERFACE
 
+
 uses exec, workbench;
 
+
 Const
 
     ICONNAME    : PChar = 'icon.library';
@@ -39,8 +51,25 @@ FUNCTION MatchToolValue(typeString : pCHAR; value : pCHAR) : BOOLEAN;
 FUNCTION PutDefDiskObject(diskObject : pDiskObject) : BOOLEAN;
 FUNCTION PutDiskObject(name : pCHAR; diskobj : pDiskObject) : BOOLEAN;
 
+
+FUNCTION BumpRevision(newname : string; oldname : pCHAR) : pCHAR;
+FUNCTION BumpRevision(newname : pCHar; oldname : string) : pCHAR;
+FUNCTION BumpRevision(newname : string; oldname : string) : pCHAR;
+FUNCTION DeleteDiskObject(name : string) : BOOLEAN;
+FUNCTION FindToolType(toolTypeArray : POINTER; typeName : string) : pCHAR;
+FUNCTION GetDiskObject(name : string) : pDiskObject;
+FUNCTION GetDiskObjectNew(name : string) : pDiskObject;
+FUNCTION MatchToolValue(typeString : string; value : pCHAR) : BOOLEAN;
+FUNCTION MatchToolValue(typeString : pCHAR; value : string) : BOOLEAN;
+FUNCTION MatchToolValue(typeString : string; value : string) : BOOLEAN;
+FUNCTION PutDiskObject(name : string; diskobj : pDiskObject) : BOOLEAN;
+
+
 IMPLEMENTATION
 
+
+uses pastoc;
+
 FUNCTION AddFreeList(freelist : pFreeList; mem : POINTER; size : ULONG) : BOOLEAN;
 BEGIN
   ASM
@@ -204,7 +233,71 @@ BEGIN
   END;
 END;
 
+
+FUNCTION BumpRevision(newname : string; oldname : pCHAR) : pCHAR;
+begin
+      BumpRevision := BumpRevision(pas2c(newname),oldname);
+end;
+
+FUNCTION BumpRevision(newname : pCHar; oldname : string) : pCHAR;
+begin
+      BumpRevision := BumpRevision(newname,pas2c(oldname));
+end;
+
+FUNCTION BumpRevision(newname : string; oldname : string) : pCHAR;
+begin
+      BumpRevision := BumpRevision(pas2c(newname),pas2c(oldname));
+end;
+
+FUNCTION DeleteDiskObject(name : string) : BOOLEAN;
+begin
+      DeleteDiskObject := DeleteDiskObject(pas2c(name));
+end;
+
+FUNCTION FindToolType(toolTypeArray : POINTER; typeName : string) : pCHAR;
+begin
+      FindToolType := FindToolType(toolTypeArray,pas2c(typeName));
+end;
+
+FUNCTION GetDiskObject(name : string) : pDiskObject;
+begin
+      GetDiskObject := GetDiskObject(pas2c(name));
+end;
+
+FUNCTION GetDiskObjectNew(name : string) : pDiskObject;
+begin
+      GetDiskObjectNew := GetDiskObjectNew(pas2c(name)); 
+end;
+
+FUNCTION MatchToolValue(typeString : string; value : pCHAR) : BOOLEAN;
+begin
+       MatchToolValue := MatchToolValue(pas2c(typeString),value);
+end;
+
+FUNCTION MatchToolValue(typeString : pCHAR; value : string) : BOOLEAN;
+begin
+       MatchToolValue := MatchToolValue(typeString,pas2c(value));
+end;
+
+FUNCTION MatchToolValue(typeString : string; value : string) : BOOLEAN;
+begin
+       MatchToolValue := MatchToolValue(pas2c(typeString),pas2c(value));
+end;
+
+FUNCTION PutDiskObject(name : string; diskobj : pDiskObject) : BOOLEAN;
+begin
+       PutDiskObject := PutDiskObject(pas2c(name),diskobj);
+end;
+
+
 END. (* UNIT ICON *)
 
+{
+  $Log$
+  Revision 1.2  2002-11-18 20:54:32  nils
+    * update check internal log
+
+}
 
+