Molly: Corrected name of image and added some extra line between image and source code

2014-08-09T11:16:18Z

Corrected name of image and added some extra line between image and source code

Molly: Initial content

2014-08-09T11:06:53Z

Initial content

New page

Unfortunately no real explanation(s) yet, just some piece of code i wanted to 'rescue' out of the aros-exec.org 'haystack'.

The code is quite self-explanatory though.

The code was originally presented in [http://aros-exec.org/modules/newbb/viewtopic.php?viewmode=flat&type=&topic_id=8050&forum=1 this thread], [http://aros-exec.org/modules/newbb/viewtopic.php?post_id=79294#forumpost79294 this post] to be exact (2-3-2013).

Another interesting (related) thread is [http://aros-exec.org/modules/newbb/viewtopic.php?viewmode=flat&type=&topic_id=8081&forum=2 this one], in which i stumbled upon some WritePixelArray() (/Alpha) curiosity (5-3-2013).

But the 'mother' of all threads is [http://aros-exec.org/modules/newbb/viewtopic.php?viewmode=flat&type=&topic_id=4176&forum=1 this one] (21-1-2010)), in which the author of the new mouse pointer implementation explains how things are suppose to work in practice (don't worry, all the important information is already supplied in the comments of the presented source-code).

Unfortunately code is also still in my old stubborn 'use my unts and types'-format, so it won't compile out of the box (hence this example is not situated on the main page from ALB).

First a little picture of a slight variation on the presented code (using 64x64 pointer instead of 32x32)

[[File:Example.jpg]]

<source lang="pascal">
program SinglePointerV2b;

{$MODE OBJFPC}{$H+}

uses
aros_types,
aros_exec,
aros_dos,
aros_graphics,
aros_intuition,
aros_cybergraphics,
mytagsarray;

(*
author : MaGoRiuM
date : 03-march-2013
Name : singlepointer revision V2b
Topic : A quick'n'dirty mousepointer changing test
Target : AROS
Usage : Start from shell. No other windows must be open
to ensure the shell-window is the first window
on the screen. If not then the windows that has its
cursor changed needs to be activated before the changes
to the mousepointer are visible.
The name of the window for which the mousepointer
is changed is written in the shell along with
other debug information.
Tested in vesa mode only. Max dimensions tested
64*64*32 (w*h*d)
Disclaimer: Use and abuse at your own risk.
This file is not meant for distribution. Its
purpose is being an example. Bad coding style(tm)
applies.
*)

(*
Important notes:

From Sonic in "New Mouse Pointer" thread on aros-exec.org

FWIW Sonic is the AROS system developer that implemented the
mousepointerclass.

- The pointerclass attributes are not settable. You can pass them only
during object creation.
- If you want several different pointers then create several different
objects. Then just switch between them using SetWindowPointer().
- Dont recreate the bitmap each time. After creating a pointerclass
object you may re-use it. The bitmap is NOT attached to the created
object in any way, data are copied and stored internally.
See rom/intuition/pointerclass.c for more details.
- Pixelformat specifies the order of bytes in RAM, not in a longword. So
they are endianess-dependant. Take this into account if you use longword
to specify your pointer image.
*)

(***************************************************************************)
(** **)
(** Routines that are missing from default units **)
(** **)
(***************************************************************************)

Const
BMF_SPECIALFMT = 1 shl 7; // Missing tag in agraphics unit.

function NewObject(classPtr : pIClass; const classID: pChar; const tags : array of const) : Pointer;
begin
// Cast to pointer to avois clas between aros_utility and utility unit.
NewObject := NewObjectA(classPtr, ClassID, Pointer(readinTags(tags)));
end;

procedure SetWindowPointer(win : pWindow; const tags : array of const);
begin
// Cast to pointer to avoid clash between aros_utility and utility unit.
SetWindowPointerA(win, pointer(readintags(tags)));
end;

(***************************************************************************)
(** **)
(** Actual implementation **)
(** **)
(***************************************************************************)

Const
TAG_DONE = 0; // for convenience, no need for utility unit.

RawDataWidth = 16; // The width in pixels of our rawdata
RawDataHeight = 16; // The height in pixels of our rawdata

Var
RawData_16x16 : packed array[0..(RawDataWidth*RawDataHeight)-1] of longword =
(
// format AABBGGRR;
$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FF0000,
$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FFFFFF,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00000000,$00FF0000,$00FF0000,
$000000FF,$000000FF,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,
$000000FF,$000000FF,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00,$0000FF00
);

(*
Routine that creates an actual AROS cursor from the raw cursor data.
Width, Height and Depth describes the raw data.
*)
Function AllocAROSPointer(Width, Height, Depth: Integer; RawData: pLongWord): pObject_;
var
px, py, r : Integer;
CursorBM : pBitmap;
CursorRP : pRastPort;
cc : LongWord;
aa,rr,gg,bb : Byte;
AROSCursor : pObject_;
WordWidth : LongInt;
//RawDataAccess : pRawCursorData;

begin
AROSCursor := nil;
{
Now we need to actually make real AROS cursor
out of the raw data that is given.

It is a slow process but luckiliy this could
be execute tbefore a program actually runs so
that it will not take away runtime performance.
}

{
Step 1:
allocate an offscreen bitmap to copy the rgb32 pixeldata
into. This creates a bitmap, that is unfortunately needed
by AROS to create a new pointer.
}
CursorBM := AllocBitMap(
Width, // sizeX, pixelwidth desired for bitmapdata
Height, // sizey, pixelheight desired for bitmapdata
Depth, // depth, number of bitplanes tha are at least allocated (32 bit for RGBA32)
BMF_MINPLANES or BMF_SPECIALFMT or (PIXFMT_RGBA32 shl 24), // flags, see documentation
nil // pRastPort(window^.RPort)^.BitMap
);

if (CursorBM <> nil)
then writeln('allocated bitmap')
else writeln('ERROR: allocating bitmap failed');

{
Step 2:
A rastport to the offscreen-bitmap is needed in order to be able to
actually write anything into the bitmap.
On classic we would use initrastport, but AROS specifically tells use to
use CreateRastPort(). Using inintrastport in this situation will freeze
AROS-OS.
NOTE: the rastport needs to be freed as well.
}

CursorRP := CreateRastPort;
if (CursorRP <> nil)
then writeln('created rastport for cursor')
else writeln('ERROR: creating rastport for cursor failed');

{
Step 3:
Attach bitmap to rastport to make connection.
}
CursorRP^.Bitmap := CursorBM;

{
Step 4:
The RAW defined pixeldata needs to be:
- copied into the bitmap
- an cursor object needs to be created from this bitmap
}

begin
{
Step 4a:
Copy data into the bitmap
}
// initialize the counter used to count the nr of pixels that are
// drawn into the bitmap without any error.
r := 0;

for py := 0 to Height-1 do
begin
for px := 0 to Width-1 do
begin
// get color asociated with the current pixel
cc := rawdata[py*width+px];
// break color component of pixel into seperate ARGB colorvalues
rr := cc shr 0 and $FF;
gg := cc shr 8 and $FF;
bb := cc shr 16 and $FF;
aa := cc shr 24 and $FF;

{
// Check if the pixel is transparant (RGB=000)
// If pixel is transparent we override alpha channel
// if pixel has alphavalue we need to fill in alphavalue
// for testing purpose only we fill in $FF which mean full color, no alpha
}
if (rr+gg+bb = 0) then aa := $00 else aa := $FF;
// Put back the colors + corrected alpha value into the correct format in order to be able to write a pixel
cc := (aa shl 24) + (rr shl 16) + (gg shl 8) + (bb);
// write the pixel into the bitmap
// cast to pointer because of type conflict between aros_graphics and agraphics unit.
If WriteRGBPixel(Pointer(CursorRp), px, py, cc) = 0 then
begin
// if the pixel is written ok, increase counter so pixelwritecount can be checked
inc(r);
end;
end; // for pixel-coordinates x
end; // for pixel-coordinates y

// write out the number of pixels that were written into the bitmap
// if it doesn't match px*py then an error occured.
writeln('wrote ', r, ' pixels into bitmap');

{
Step 4b:
Now that the bitmap is setup correctly we attempt to create a cursor from it.
}
WordWidth := (Width + 15) shr 4;

AROSCursor := NewObject(nil,'pointerclass',
[
POINTERA_BitMap , CursorBM,
POINTERA_WordWidth , WordWidth, // width of cursor in words.
//POINTERA_XResolution, POINTERXRESN_DEFAULT,
//POINTERA_YResolution, POINTERYRESN_DEFAULT,
POINTERA_XResolution, POINTERXRESN_SCREENRES,
POINTERA_YResolution, POINTERYRESN_SCREENRESASPECT,
//POINTERA_XOffset , 0, // Hotspot x
//POINTERA_YOffset , 0, // hotspot y
TAG_DONE
]);

If (AROSCursor <> nil)
then writeln('allocated new pointer object')
else writeln ('ERROR: could not create new pointer object');

// assume object is created
Result := AROSCursor;
end; // done creating mousepointer object

{ Step 5:
Give back the rastport
}
FreeRastPort(CursorRP);

{ Step 6:
Give back the bitmap
}
FreeBitMap(CursorBM);

{
!!!!! DONE !!!!!
}

end;

(*
Routine that free the AROS cursor and so give back the created object
*)
Procedure FreeAROSPointer(Var AROSCursor: PObject_);
begin
if AROSCursor <> nil then
begin
// we are done with our pointer so we can free the pointerclass
// Actually it is undetermined what happens if a cursor is
// still in use by the AROS system.
DisPoseObject(AROSCursor);
AROSCursor := nil;
writeln('Disposed AROS object');
end
else writeln('ERROR: AROS pointerObject was not allocated and could therefore not be destroyed');
end;

(*
Routine to test the mousepointer
Delaycount = the nr of milliseconds to change the pointer
AROSPointer = the feshly created mousepointer class that
needs is being shown.
*)
Procedure TestPointer(delaycount: Integer; AROSPointer: pObject_);
var
screen : pScreen;
Window : pWindow;
begin
// A window is needed, so start-out with a screen.
Screen := LockPubScreen(nil);
if (screen <> nil) then
begin
writeln('found screen ', screen^.Title);

// get the window that is desperately needed
window := Screen^.firstwindow;
if (window <> nil) then
begin
writeln('found window ',window^.title);

writeln('Starting cursor demo');
begin
writeln('Attempting to display cursor');

// if the given pointer is valid then continue
If AROSPointer <> nil then
begin
// actually link the mousepointer to the window
// so that it becomes visible when the window is
// activated.
SetWindowPointer(Window, [WA_Pointer, AROSPointer, TAG_DONE]);

writeln('Current cursor is being displayed');
// Wait some time before returning back.
DOSDelay(DelayCount);
end
else writeln('ERROR: Cursor did not had a valid object');

end;
writeln('ending cursor demo');

// after fiddling and changing the cursor, the window
// needs back its original cursor.
// Unfortunatly there is no way of knowing if giving
// back the default cursor succeeded or not.
SetWindowPointer(Window, [WA_Pointer, 0, TAG_DONE]);

end else writeln('CERROR: ould not locate a window');

// Albeit a bit late, the locked screen must really be unlocked.
unlockpubscreen(nil, screen);

end else WriteLn('ERROR: could not locate a screen');
end;

(*
MAIN
*)
Var
AROSMousePointer : pObject_;

begin
writeln('enter');

// create real AROS mousepointer class from raw data
AROSMousePointer := AllocAROSPointer(16,16,32, @RawData_16x16[0] );
//AROSMousePointer := AllocAROSPointer(32,32,32, @RawData_32x32[0] );
//AROSMousePointer := AllocAROSPointer(64,64,32, @RawData_64x64[0] );
If AROSMousePointer <> nil then
begin
writeln;
// Do some visual mousepointer changing
TestPointer(1000, AROSMousePointer);
writeln;
// Free the AROS mousepointer object.
FreeAROSPointer(AROSMousePointer);
end;
writeln('leave');
end.

</source>

@@ Line 13: / Line 13: @@
 First a little picture of a slight variation on the presented code (using 64x64 pointer instead of 32x32)
-[[File:Example.jpg]]
 <source lang="pascal">

Intuition.SetWindowPointerA() - Revision history

Molly: Corrected name of image and added some extra line between image and source code

Molly: Initial content