Workshop:Amiga, Pascal, graphics.library and timer.device
Respect the copyright
This workshop is based on the workshop titled "Retrocoding: Amiga, C, graphics.library und timer.device" which is written and copyrighted by Kai Scherrer.
The workshop you read here is a translation into English from the work done by Kai. The original workshop was aimed at the c-programmer and also this part has been rewritten here to address the Pascal programmer instead.
That means that the workshop here contains some changes in comparison to the original work done by Kai. The translation and changes respects and upholds original authors copyright.
Let's start with clarifying something first: Everything read in this lead section is written by me (the translator). That also means that text listed in and after the table of contents is based on the work written by original author.
This should hopefully clear things up with regards of the use of the words "I", "we" and "me".
This document is a translation (from German to English, changed programming language from c to Pascal) of a programming workshop for the Amiga, originally written by Kai Scherrer.
The original author wrote this tutorial for the c programming language as well as introduced the reader to different c-compilers for the Amiga as well as discussed their advantages/disadvantages and/or usage.
Because this document is targeting users that (want to) program using the Pascal language, there are many difference in comparison to the original documentation. As you perhaps might have noticed, these differences begin right from the start including this foreword.
notes with regards to Free Pascal
This documentation is aimed at those using the Free Pascal compiler. This compiler is able to run on a variety of operating systems including Amiga, AmigaOS, AROS and MorphOS (so you can use the compiler natively), but can also be used to cross-compile f.e. from Windows, Mac and/or Linux to target the aforementioned platforms.
Another wicked alternative for compiling single-file projects is using the online compiler. There is even a special version of the online compiler for old browsers that don't quite handle javascript
Note that the original author used vbcc for his workshop and that Free Pascal is able to use the same back-end (vasm/vlink) that is used by vbcc to create executables. In fact this is default when compiling natively on Amiga for example.
Free Pascal uses some defaults that might not always be obvious for most. For example, current API units automatically opens and closes libraries for you when you include such a unit in your project. The auto-opening and closing is something that usually isn't done for most programming languages targeting the Amiga platform.
Another note worth mentioning is the fact that Pascal does not has a dedicated program entry point by the name of main. As such, there is also no main header declaration. But, if you have your roots in c-programming and can't live without main() then this can easily be accommodated, for example:
// c main like entry-point.
function main(argc: Integer; argv: PPChar): integer;
begin
if EverthingElseWentOk()
then result := RETURN_OK
else result := RETURN_FAIL;
end;
// This is the Pascal equivalent of main program entry point
begin
ExitCode := main(ArgC, ArgV);
end.
Note that Pascal uses the identifier ExitCode to return a value to the shell but also realize that ArgC and ArgV can't be used to distinguish between program-startup from shell or WB (red: is that true ?)
Foreword
As a typing exercise i wrote a simple and small Graphics-Engine. Actually "engine" is perhaps a bit exaggerated, but for the sake of simplicity and lack of a better word, my little baby has been written :-)
This gave me the idea to write a small workshop that handles the topic of Amiga Programming. In this workshop i describe the function and development progress of the engine, as well as explain some details about some of the components of AmigaOS.
The engine itself uses double-buffering to display the graphics: drawing operations are performed on a non-visible bitmap and only when a image is completely finished drawing, it is then copied to the visible bitmap of the window in one go. Later in the workshop, I would like to use this technique to display a full-screen image that does not copy the contents of the bitmaps, but uses the bitmaps themselves to display.
The desired frame rate is freely adjustable and is controlled by timer.device. In addition, we will control each animation based on the actual time that past, so that animations can be played at the correct speed even if the computer fails to keep up with the frame rate.
Our engine is designed to operate in a system-friendly and multitasking environment that runs on OS 1.2 and up (red: Free Pascal currently only provide headers that match OS3.x). As of OS 3.0, functionality is used which improves performance for graphics cards. However, in the current version there is no further support for such RTG-systems: Our renderer is therefor limited to 8-bit graphics. Nor is there any support for special features of the Amiga chipset: So there will be no hardware scrolling, sprites or copperlists.
For those there is another nice play-field where you can play and experiment with the functions of graphics.library and bitplanes - and in principle and without much changes, the obtained results can also be incorporated in 'real' demo's, games or programs.
To accomplish this I will introduce some basic functions from graphics.library to develop a simple 2d vector renderer that is even able to reach acceptable performance on stock 68000 systems.
In order to be able to follow this workshop you need a working Pascal compiler. Therefor i will start with a short explanation on the installation and use of Free Pascal.
In addition, you should have at least some rudimentary knowledge of the Pascal programming language. I will not provide too much background information otherwise. Although it would be nice to have everything explained all in one place, on the other hand we do not want to dwell too much into known details. So if you don't understand something from this workshop then don't hesitate to ask. At best you would have me revise he relevant posts or add some digression.
And now for some fun!
A quick view on Pascal compilers
There are quite a few Pascal compilers available for the Amiga. Unfortunately almost none of them are are kept up to date. A notable exception is Free Pascal, which is constantly improving by its developers. Amongst those developers are also a few that keep an eye on Amiga supports. I'll briefly go over a few important compilers here:
UCSD Pascal
More research required.
Amiga Pascal
Also known as MCC Pascal. Distributed by Commodore, developed by MetaComCo (a division of Tenchstar, Ltd.).
AmigaPascal
A mini Pascal compiler developed by Daniel Amor and released as freeware (binary only, closed source). Appeared on Fred Fish in 1993.
HSPascal
This Pascal seem to have appeared around 1990 and produced executables for Amiga and Atari. It was developed by Christen Fihl and sold under different names as MAXON Pascal (by MAXON Computers) and as HighSpeed Pascal (by HiSOFT, staff aquired by MAXON Computers in 2003). Note that MAXON Computers also sold another Pascal language related product named Kick Pascal. At this point in time it's unclear (red: to me the translator) what the relation (if any) is between the different branding.
HighSpeed Pascal
See HSPascal. Closed source commercial product. Development seized.
Kick Pascal
See HSPascal. Closed source commercial product. Development seized.
MAXON Pascal
See HSPascal. Closed source commercial product. Development seized.
PCQ Pascal
Originally published as Public Domain Pascal compiler. Developed by Nils, Patrick and ????. Later released as freeware and as Open Source.
Free Pascal
And we kept the best for last. The Free Pascal compiler initially started out as FPK (by it's author initials Florian Paul Klampfl). People also refer to it as FPC.
The sources presented in this workshop are Free Pascal compatible. Don't try to use any of the other aforementioned compilers unless you know what you're doing.
Free Pascal installation on AmigaOS
At least one archive is required in order to be able to use the compiler for Amiga projects.
This archive can be found:
- here for Amiga OS3/AROS-m68k
- here for Amiga OS4
- here for AROS (select the correct target CPU)
- here for MorphOS
Make sure you download the archive that has "fpc 3.1.1" + "LCL" in its name, except for AROS that should have te word "trunk" in its name. Note that this archive is around 250MB in size when extracted.
Then take the following steps:
- Extract the archive where the archive's root-folder named pp can be extracted.
- create an assign Freepascal: to this folder, preferably in your Startup Sequence or User Startup.
- add a path to the drawer where fpc executable is located, e.g: "path add Freepascal:bin/m68k-amiga". Replace m68k-amiga with ppc-amiga for OS4, with ppc-morphos for MorphOS and do something similar for AROS depending on the architecture on which you run the compiler. Do this preferably in your Startup Sequence or User Startup.
- reboot to make sure the assign and paths are active.
Now we make a quick test to verify your setup:
Create a file named test.pas with the following content:
program test;
uses
AmigaDOS;
var
hello : PChar;
begin
hello := 'Hello Amiga!' + sLinebreak;
DOSWrite(DOSOutput, hello, Length(hello));
WriteLn('Hello Pascal!');
ExitCode := RETURN_OK;
end.
You can compile that with FPC using the following statement:
fpc test.pasIf this is compiled without error, then start your test. This should simply output two lines:
Hello Amiga!
Hello Pascal!If this test was successful then you can continue the workshop with your compiler setup.
Pascal and AmigaOS
Because it fits perfectly here, I would like to take the opportunity to point out how Pascal and AmigaOS works interchangeably. In our test.pas we are immediately confronted by three different situations:
- First we have the core Pascal language itself. Located in our example, you see the use of a basic type such as PChar and predefined constant sLineBreak.
- Then we have the functions from the standard Pascal library. In our example these are the functions Length() and WriteLn(), which are declared in the system unit. These functions are available on any system and are typically part of the compiler package itself.
- And last but not least, we have the AmigaOS system calls. These are of course only available on Amiga systems and are supplied via the additional platform specific units. From the Pascal programming point of view, AmigaOS looks like a large collection of functions and data types. In our example, these are the two functions DOSWrite() and DOSOutput() from dos.library, as well as the constant RETURN_OK, which are all declared in the unit AmigaDOS. These units can be found in the packages folder packages/amunits. Note that the the ominous amiga.lib is not required for these functions as quite recently the use of this unit is deprecated (red: since unreleased yet Free Pascal version 3.2.x, that is why you should use FPC trunk 3.1.1)
So, now it should be clear why our test.pas reads as it does: It will check whether our compiler installation is complete so we can use both the standard library and the Amiga system calls.
Here we go
What do we actually want to write right now ? Here is a quick description: We want to open a simple, resizable window on the Workbench where we can draw graphics using the graphics library - using accurate timed animation. Of course this should all be implemented in a system-friendly manner e.g. it should immediately respond to user interaction and consume as less computer time and resources as necessary. That sounds easier than it actually is therefor we will implement this step-by-step.
We will begin with our main entry-point. We do not want add too much code in there, but the main entry-point is a perfect place to check the presence of required libraries. For our implementation that would be intuition.library that is used for our window and graphics.library that is needed for our drawing commands.
First we define two global variables that represent the base address for the libraries:
//* our system libraries addresses */
var
GfxBase : PGfxBase absolute AGraphics.GfxBase;
IntuitionBase : PIntuitionBase absolute Intuition.IntuitionBase;
Did you remember that these variables are already defined in our Pascal support units ? That is why we map them to their original variable by using the keyword absolute.
(Red: usually you would not have to do this mapping and you can use the variables GfxBase and IntuitionBase from their units directly, but a) we want to stay as close to the original c-source as possible and b) there currently is a tiny incompatibility with the type definition amongst supported platforms. Remember that this source can be compiled for Amiga, AmigaOS, AROS and MorphOS).
Because the libraries are also opened and closed automatically for us when the corresponding unit is included we do not initialize these variables.
Instead we check in our main entry-point if indeed the libraries were opened successfully and if they match required version. That looks like this:
var
result : Integer;
begin
//* as long we did not execute RunEngine() we report a failure */
result := RETURN_FAIL;
//* we need at least 1.2 graphic.library's drawing functions */
if Assigned(GfxBase) and (GfxBase^.LibNode.lib_Version >= 33) then
begin
//* we need at least 1.2 intuition.library for our window */
if Assigned(IntuitionBase) and (IntuitionBase^.LibNode.lib_Version >= 33) then
begin
//* All libraries needed are available, so let's run... */
result := RETURN_OK;
//* Closing Intuition library and setting its baseaddress to nil */
//* is not necessary as Pascal does that automatically for us */
end;
//* Closing Graphics library and setting its baseaddress to nil */
//* is not necessary as Pascal does that automatically for us */
end;
//* Pascal uses System variable ExitCode to report back a value to caller
ExitCode := result;
end;
As soon as we've made sure that the libraries where opened successfully, we initialize our own data, open the window and jump into the main loop. We will do this in our own function named RunEngine(). We also define a record structure where we store our run-time data, so that we can easily pass along a pointer to all functions involved. This avoids the use of ugly global variables:
type
PRenderEngineData = ^TRenderEngineData;
TRenderEngineData =
record
window : PWindow;
run : boolean;
end;
function RunEngine: integer;
var
rd : PRenderEngineData;
newWindow : TNewWindow;
begin
//* as long we did not enter our main loop we report an error */
result := RETURN_ERROR;
(*
allocate the memory for our runtime data and initialize it
with zeros
*)
rd := PRenderEngineData(ExecAllocMem(sizeof(TRenderEngineData), MEMF_ANY or MEMF_CLEAR));
if assigned(rd) then
begin
//* now let's open our window */
with newWindow do
begin
LeftEdge := 0; TopEdge := 14;
Width := 320; Height := 160;
DetailPen := UBYTE(not(0)); BlockPen := UBYTE(not(0));
IDCMPFlags := IDCMP_CLOSEWINDOW or IDCMP_NEWSIZE or IDCMP_REFRESHWINDOW;
Flags := WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_SIMPLE_REFRESH or WFLG_SIZEBBOTTOM or WFLG_SIZEGADGET;
FirstGadget := nil; CheckMark := nil;
Title := 'Gfx Workshop';
Screen := nil;
BitMap := nil;
MinWidth := 96; MinHeight := 48;
MaxWidth := UWORD(not(0)); MaxHeight := UWORD(not(0));
WType := WBENCHSCREEN_f;
end;
rd^.window := OpenWindow(@newWindow);
if Assigned(rd^.window) then
begin
//* the main loop will run as long this is TRUE */
rd^.run := TRUE;
result := MainLoop(rd);
//* cleanup: close the window */
CloseWindow(rd^.window);
rd^.window := nil;
end;
//* free our runtime data */
ExecFreeMem(rd, sizeof(TRenderEngineData));
rd := nil;
end;
end;
The trained eye would have spotted immediately that we first allocate the memory for our RenderEngineData, initially filling the structure with zero's, and then open the window. This is a simple refresh window, which is why we also request that we want to receive IDCMP_REFRESHWINDOW messages from intuition.library and which allows us to redraw the contents of the window. Because we are going to redraw the window several times per second, using a smartrefresh window (where intuition would take care of redrawing) would be superfluous (red: counterproductive ?)
If everything worked out as intended then we jump into our MainLoop():
function MainLoop(rd: PRenderEngineData): integer;
var
winport : PMsgPort;
winsig : ULONG;
msg : PMessage;
begin
//* remember the window port in a local variable for more easy use */
winport := rd^.window^.UserPort;
//* create our waitmask for the window port */
winSig := 1 shl winport^.mp_SigBit;
//* our main loop */
while (rd^.run) do
begin
//* let's sleep until a message from our window arrives */
Wait(winSig);
{*
our window signaled us, so let's harvest all its messages
in a loop...
*}
while true do
begin
msg := GetMsg(winport);
if not assigned(msg) then break;
//* ...and dispatch and reply each of them */
DispatchWindowMessage(rd, PIntuiMessage(msg));
ReplyMsg(msg);
end;
end;
result := RETURN_OK;
end;
We stay inside our main loop as long as rd^.run flag remains TRUE. We want to set this flag to false as soon as the user clicks on the close gadget of our window. Inside the main loop we'll wait until we get a signal from the window which is send by a message, modify that message, and reply to this message(s) using a loop. The modification of the message takes part inside function DispatchWindowMessage() as follows:
procedure DispatchWindowMessage(rd: PRenderEngineData; msg: PIntuiMessage);
begin
case (msg^.IClass) of
IDCMP_CLOSEWINDOW:
begin
{*
User pressed the window's close gadget: exit the main loop as
soon as possible
*}
rd^.run := FALSE;
end;
IDCMP_REFRESHWINDOW:
begin
BeginRefresh(rd^.window);
EndRefresh(rd^.window, TRUE);
end;
end;
end;
Here we react to IDCMP_CLOSEWINDOW by setting our run-flag to false, which will cause us to leave our main loop as soon as all the other messages have been processed.
Because we still have nothing to draw, we simply call Beginrefresh()/EndRefresh() on a IDCMP_REFRESHWINDOW, by which we tell intuition that we have successfully redrawn our window.
If we compile all the above code (engine1.pas) Then we get an empty, resizable window, which we can close again. Great, isn't it? ;-)
fpc engine1.pas
[ you should be looking at a picture here ]
Bitplane, BitMap and RastPort
So how do we actually draw into our window ? In order to accomplish this, i would like to take a few steps back first and clarify some of the terminology used by graphics.library.
First there is the graphics memory itself. For the classic graphics.library, this is always arranged in planar format, meaning that depending of the number of colors we have a corresponding number of bitplanes where each single bit represents a pixel. This allows for maximum flexibility in terms of the desired number of colors, but the downside is that drawing operations are quite complicated because for every pixel you need to read one byte for each bitplane, perform a and/or operation and write back the byte again. Even if the graphics memory is located in chip RAM, then performing slow actions on it slow things down even further because access to this kind of memory is slow to begin with. Initially we do not have to worry about these things, because graphics.library will handle this for us but, if you need fast and up-to-date graphics then it is difficult to circumvent the use of a chunky2planar-routine. But for now, this topic will not be an issue.
In order for graphics.library to determine which Bitplanes actually belong to a image as well as be able to tell what its dimensions are, there is a record structure TBitmap declared in agraphics.pas:
type
TBitMap = record BytesPerRow: Word; Rows: Word; Flags: Byte; Depth: Byte; Pad: Word; Planes: array[0..7] of TPlanePtr; end;
BytesPerRow specifies how many bytes per line are used. More specifically, it is the number of bytes you have to add to a point in order to locate the pixel from the same column in the next row. Because there are no half-bytes this means that the width in pixels is always a multiple of 8. Due to some characteristics of the Amiga chipset, this number is in practise even a multiple of 16, e.g. the memory usage of a bitmap with a width of 33 pixels is identical to that of a bitmap with a width of 48 pixels.
rows specifies the number of lines and thus directly corresponds to the height of a bitmap in pixels.
depth specifies the number of Bitplanes and thus corresponds to the available color depth: With only one Bitplane you have two colors, with eight Bitplanes 256.
Planes is an array of addresses that point to our Bitplanes in memory. Although the size of the array is defined with 8, one must not rely - at least with bitmaps that you have not created yourself - that there are actually eight addresses available.
For a bitmap with a depth of 2, it may very well be that the memory for the last 6 Bitplane pointers is not allocated. This means that when you access this array, you always have to take the depth into consideration: if depth is 2, then you must not access planes [2] - not even to test whether the pointer is nil ! Planes that are outside the range specified by depth are considered non-existent !
Also assignments in the form of:
var
bmp: TBitmap;
begin
bmp:= foreignBmp^;
end;
are doubtful and should be avoided if you have not allocated the foreignBmp directly yourself !
That also means that different bitmap objects can refer to the same Bitplanes in memory.
By using the bitmap structure graphics.library knows about the basic structure of the Bitplanes, how many there are and their position. However for drawing operations it needs some more information: In addition to the bitmap, graphics.library has to memorize its state somewhere such as which pen is set, which draw-mode is active, which font is used, and much more. This is done with the rastport structure , which is defined agraphics.pas. Such a RastPort is needed for most of the drawing routines of graphics.library. And, of course, several Rasports with different settings can point to the same Bitmap as drawing-target.
Very thoughtful, our window already provides an initialized RastPort that we can use. But beware: this RastPort covers the entire window, including frames and system gadgets. So when you color this rastport completely using SetRast you'll end up with a single solid area on your workbench that has the exact size as the window.
This is how a simplified representation of the connection between RastPort, bitmap and Bitplanes looks like:
[ you should be looking at a picture here ]
The smart ones amongst us that draw the bitmap using the RastPort of the window are likely to experience another surprise: this bitmap actually maps to the content of the complete screen and as long as you use the RastPort of the window, layers.library ensures that drawing operations do not occur on areas outside the window or other hidden/covered areas. If you do this in such a way that you encapsulate the window rastport-bitmap in your own rastport and color it by using SetRast() then you'll end up with a complete single-colored screen and for sure will upset some users ;-)
We're finally going to draw something
With this knowledge in mind we now return to our window and its messages again: we have to draw our graphics on several occasions:
- First, immediately after the window opens, so that initially the graphic is displayed at all.
- Then, when a IDCMP_REFRESHWINDOW message is recieved, to refresh those regions on the window that are destroyed.
- And of course also after the user has changed the size of the window.
It is therefore logical that we implement our drawing functionality into a separate function that we can call when needed:
procedure RepaintWindow(rd: PRenderEngineData);
var
rastPort : PRastPort;
outputRect : TRectangle;
lineStep : TPoint;
pos : TPoint;
i : integer;
const
stepCount = 32;
begin
//* we make a local copy of our RastPort pointer for ease of use */
rastPort := rd^.window^.RPort;
//* our output rectangle is our whole window area minus its borders */
outputRect.MinY := rd^.window^.BorderTop;
outputRect.MinX := rd^.window^.BorderLeft;
outputRect.MaxX := rd^.window^.Width - rd^.window^.BorderRight - 1;
outputRect.MaxY := rd^.window^.Height - rd^.window^.BorderBottom - 1;
//* clear our output rectangle */
SetDrMd(rastPort, JAM1);
SetAPen(rastPort, 0);
RectFill(rastPort, LongInt(outputRect.MinX), LongInt(outputRect.MinY),
LongInt(outputRect.MaxX), LongInt(outputRect.MaxY));
//* now draw our line pattern */
lineStep.x := (outputRect.MaxX - outputRect.MinX) div stepCount;
lineStep.y := (outputRect.MaxY - outputRect.MinY) div stepCount;
SetAPen(rastPort, 1);
pos.x := 0;
pos.y := 0;
for i := 0 to Pred(stepCount) do
begin
GfxMove(rastPort, LongInt(outputRect.MinX) , LongInt(outputRect.MinY + pos.y));
Draw(rastPort, LongInt(outputRect.MaxX - pos.x), LongInt(outputRect.MinY ));
Draw(rastPort, LongInt(outputRect.MaxX) , LongInt(outputRect.MaxY - pos.y));
Draw(rastPort, LongInt(outputRect.MinX + pos.x), LongInt(outputRect.MaxY ));
Draw(rastPort, LongInt(outputRect.MinX) , LongInt(outputRect.MinY + pos.y));
pos.x := pos.x + lineStep.x;
pos.y := pos.y + lineStep.y;
end;
end;
First we determine the output rectangle by subtracting the corresponding borders fro the window width and height. This rectangle is then completely deleted by RectFill().After that we just paint a few lines with the Draw() function. Note that when lines are drawn that we only specify the end point. The starting point is stored in the RastPort and either can be set by Move() or act as end point for/to ? a previous drawing operation.
Now we have to make sure that our repaint function is invoked at the appropriate locations: The first time immediately before we go into the main loop in MainLoop():
//* create our waitmask for the window port */
winSig := 1 shl winport^.mp_SigBit;
//* paint our window for the first time */
RepaintWindow(rd);
//* our main loop */
while (rd^.run) do
Then at two places in DispatchWindowMessage():
case (msg^.IClass) of
IDCMP_NEWSIZE:
begin
RepaintWindow(rd);
end;
IDCMP_REFRESHWINDOW:
begin
BeginRefresh(rd^.window);
RepaintWindow(rd);
EndRefresh(rd^.window, TRUE);
end;
end;
Here i make a brief note with regards to a peculiarity of Beginrefresh() and Rerefresh (): The thought there is that only those parts of the window are redrawn that were initially obscured and are now made visible because the user moved the window. To accomplish this the layers.library is used and allows to perform drawing operations on other areas of our bitmap. This may significantly increase the speed of the redrawing, but can also cause problems with animations when you paint a "newer" image as parts of the old image persist and are not refreshed.
For the functions SetAPen(), SetDrMd(), GfxMove() and Draw(), we also need to add a Unit:
Uses
AGraphics;
When we compile engine2.pas with:
fpc engine2.pas
and execute it, we get a window in which a line pattern is drawn. When we resize the window, the graphics will also be adjusted to the new window size. However, on slow computers we can encounter the effect that you can 'see' (red: follow ?) the drawing operations: It is not very dramatic yet but there is a visible flicker when redrawing, because the lines appear after the background is deleted first. For now this is not too annoying yet, but we would like to play an animation, and for animations this is not acceptable behavior. The image must be visible at once.
[ you should be looking at a picture here ]
Double-buffering
We solve this problem by drawing on a second invisible bitmap first - a so-called backbuffer - and only when we finished drawing the image we replace the previous one with the new one as soon as possible. This technique is called double-buffering. The exchange itself can be done using different methods: when we display our image on a separate screen, then we can simply say to the graphics chip that it should display the second image now. This happens very quickly and without much effort. However, we are running on the workbench in a window and therefore we have to use a different method: we copy the new image over the old one. This is more complex and slower, however it is still fast enough for our purpose, especially because graphics.library can use the blitter for this. Btw "Blit" stands for "Block Image Transfer", so that it should be possible to understand where the blitter got its name from. In the context of this Workshop we will address this process as "blit" as well.
So we have to create a second bitmap and its Bitplanes now. Inside graphics.library there is a nice function that is able to do this and which is named AllocBitmap() . Unfortunately, this function is only available since OS 3.0. For previous versions of the OS we have to create the bitmap and allocate the bitplanes manually. In case there are smart readers amongst us that have come up with the idea to simply implement this by manually creating two bitmaps to never look at AllocBitmap() again, then such reader will deceive itself: AllocBitMap() specifically creates bitmaps depending on the graphics card which results in bitmaps that can be drawn faster and can blit faster to the display and should therefor always be used from OS 3.0 and onwards. That is why we implement our own AllocBitmap(), which uses one or the other method depending on the version of the OS:
function MyAllocBitMap(width: ULONG; height: ULONG; depth: ULONG; likeBitMap: PBitMap): PBitMap;
var
bitmap: PBitMap;
i : SWORD;
begin
//* AllocBitMap() is available since OS3.0 */
if (GfxBase^.LibNode.lib_Version < 39) then
begin
//* sanity check */
if (depth <= 8) then
begin
//* let's allocate our BitMap */
bitmap := PBitMap(ExecAllocMem(sizeof(TBitMap), MEMF_ANY or MEMF_CLEAR));
if Assigned(bitmap) then
begin
InitBitMap(bitmap, depth, width, height);
//* now allocate all our bitplanes */
for i := 0 to Pred(bitmap^.Depth) do
begin
bitmap^.Planes[i] := AllocRaster(width, height);
if not Assigned(bitmap^.Planes[i]) then
begin
MyFreeBitMap(bitmap);
bitmap := nil;
break;
end;
end;
end;
end
else
begin
bitmap := nil;
end;
end
else
begin
bitmap := AllocBitMap(width, height, depth, 0, likeBitMap);
end;
result := bitmap;
end;
In a similar fashion, we also need a MyFreeBitmap():
procedure MyFreeBitMap(bitmap: PBitMap);
var
width : ULONG;
i : integer;
begin
//* FreeBitMap() is available since OS3.0 */
if (GfxBase^.LibNode.lib_Version < 39) then
begin
//* warning: this assumption is only safe for our own bitmaps */
width := bitmap^.BytesPerRow * 8;
//* free all the bitplanes... */
for i := 0 to Pred(bitmap^.Depth) do
begin
if Assigned(bitmap^.Planes[i]) then
begin
FreeRaster(bitmap^.Planes[i], width, ULONG(bitmap^.Rows));
bitmap^.Planes[i] := nil;
end;
end;
//* ... and finally free the bitmap itself */
ExecFreeMem(bitmap, sizeof(TBitMap));
end
else
begin
FreeBitMap(bitmap);
end;
end;
Then we need to expand our RenderEngineStruct. First we'll store the output size in the window:
outputSize : TPoint;
In order to calculate the correct values, we write a small function:
procedure ComputeOutputSize(rd: PRenderEngineData);
begin
//* our output size is simply the window's size minus its borders */
rd^.outputSize.x :=
rd^.window^.Width - rd^.window^.BorderLeft - rd^.window^.BorderRight;
rd^.outputSize.y :=
rd^.window^.Height - rd^.window^.BorderTop - rd^.window^.BorderBottom;
end;
We call this function once after opening the window and every time when we receive a IDCMP_NEWSIZE message.
Of course we still need our bitmap, its current size and a corresponding RastPort for our RenderEngineStruct:
backBuffer: PBitMap;
backBufferSize: TPoint;
renderPort: TRastPort;
In order to create a backbuffer or adapt it to a new size, we also implement this in a function:
function PrepareBackBuffer(rd: PRenderEngineData): integer;
begin
if ( (rd^.outputSize.x <> rd^.backBufferSize.x) or
(rd^.outputSize.y <> rd^.backBufferSize.y) ) then
begin
//* if output size changed free our current bitmap... */
if Assigned(rd^.backBuffer) then
begin
MyFreeBitMap(rd^.backBuffer);
rd^.backBuffer := nil;
end;
//* ... allocate a new one... */
rd^.backBuffer := MyAllocBitMap(ULONG(rd^.outputSize.x),
ULONG(rd^.outputSize.y),
1, rd^.window^.RPort^.BitMap);
if Assigned(rd^.backBuffer) then
begin
//* and on success remember its size */
rd^.backBufferSize := rd^.outputSize;
end;
//* link the bitmap into our render port */
InitRastPort(@rd^.renderPort);
rd^.renderPort.BitMap := rd^.backBuffer;
end;
if Assigned(rd^.backBuffer)
then result := RETURN_OK
else result := RETURN_ERROR;
end;
As can be seen, this function can fail at runtime if, for some reason, the bitmap can't be created. Later we will go into the details on how to handle this situation. For the moment it is enough to return an error code in case such a situation occurs.
Our RepaintWindow() function will only blit the backbuffer in the RastPort of our window:
procedure RepaintWindow(rd: PRenderEngineData);
begin
//* on repaint we simply blit our backbuffer into our window's RastPort */
BltBitMapRastPort
(
rd^.backBuffer, 0, 0, rd^.window^.RPort,
LongInt(rd^.window^.BorderLeft),
LongInt(rd^.window^.BorderTop),
LongInt(rd^.outputSize.x), LongInt(rd^.outputSize.y),
(ABNC or ABC)
);
end;
The previously used drawing functions are migrated into a separate function:
function RenderBackbuffer(rd: PRenderEngineData): integer;
var
rastPort : PRastPort;
maxpos : TPoint;
lineStep : TPoint;
pos : TPoint;
i : integer;
const
stepCount = 32;
begin
result := PrepareBackBuffer(rd);
if (result = RETURN_OK) then
begin
//* we make a local copy of our RastPort pointer for ease of use */
rastPort := @rd^.renderPort;
//* clear our bitmap */
SetRast(rastPort, 0);
//* now draw our line pattern */
maxPos.x := rd^.backBufferSize.x - 1;
maxPos.y := rd^.backBufferSize.y - 1;
lineStep.x := maxPos.x div stepCount;
lineStep.y := maxPos.y div stepCount;
SetAPen(rastPort, 1);
pos.x := 0; pos.y := 0;
for i := 0 to Pred(stepCount) do
begin
GfxMove(rastPort, 0, LongInt(pos.y));
Draw(rastPort, LongInt(maxPos.x - pos.x), 0);
Draw(rastPort, LongInt(maxPos.x) , LongInt(maxPos.y - pos.y));
Draw(rastPort, LongInt(pos.x) , LongInt(maxPos.y));
Draw(rastPort, 0 , LongInt(pos.y));
pos.x := pos.x + lineStep.x;
pos.y := pos.y + lineStep.y;
end;
end;
end;
This function can also fail because it calls PrepareBackBuffer(). For now, we return the error code. Also note that because we have our own bitmap with corresponding RastPort, that we no longer have to pay attention to the window frames, so that we could replace the RectFill() with a SetRast().
Foolproof error-handling
Now that our code contains parts that can fail our program at runtime, we have to take care of proper error-handling. We want to be able to exit our program at any time, leaving things in a clean state and return the error code.
Leaving things in a clean state means that we will have to handle all pending messages of our window without crashing and release all allocated resources.
To accomplish this task, we will once again expand our RenderEngineData structure, this time with a return code that we can use for a error case inside our MainLoop() and to return the error code at program exit:
returnCode: integer;
In order to facilitate the error handling we want our code to call our render function from a single location only, and immediately before our call to Wait(). In order to be able determine whether or not the routine should be called we add a flag to our RenderEngineData structure. We also implement something similar for RepaintWindow():
doRepaint : boolean;
doRender : boolean;
This way we can simply set DoRender to true to render our image just before entering the MainLoop. This is how the beginning of our MainLoop looks like:
//* paint our window for the first time */
rd^.doRender := TRUE;
//* we need to compute our output size initially */
ComputeOutputSize(rd);
//* enter our main loop */
while (rd^.run) do
begin
if (rd^.doRender) then
begin
rd^.returnCode := RenderBackbuffer(rd);
if (rd^.returnCode = RETURN_OK) then
begin
//* Rendering succeeded, we need to repaint */
rd^.doRepaint := TRUE;
rd^.doRender := FALSE;
end
else
begin
//* Rendering failed, do not repaint, leave our main loop instead */
rd^.doRepaint := FALSE;
rd^.run := FALSE;
end;
end;
if (rd^.doRepaint) then
begin
RepaintWindow(rd);
rd^.doRepaint := FALSE;
end;
if (rd^.run) then
begin
//* let's sleep until a message from our window arrives */
Wait(winSig);
end;
[...]
And this shows our IDCMP_NEWSIZE handler in DispatchWindowMessage():
IDCMP_NEWSIZE:
begin
//* On resize we compute our new output size... */
ComputeOutputSize(rd);
//* ... and trigger a render call */
rd^.doRender := TRUE;
end;
When we compile and execute engine3.pas we will have reinstated our window and line pattern. However, this time without flickering when the image is redrawing - a condition that will proof to be very helpful for our next steps to animate things.
[ you should be looking at a picture here ]
Our image learns to walk
Now we want to animate our image by drawing only one iteration of our loop in RenderBackbuffer() per frame. To accomplish this we store the current counter in our RenderEngineData structure.
currentStep : integer;
The RenderBackbuffer() function is modified so that it only uses the current value for four lines per call, and then increments the value by one:
function RenderBackbuffer(rd: PRenderEngineData): integer;
var
rastPort : PRastPort;
maxpos : TPoint;
lineStep : TPoint;
pos : TPoint;
const
stepCount = 32;
begin
result := PrepareBackBuffer(rd);
if (result = RETURN_OK) then
begin
//* we make a local copy of our RastPort pointer for ease of use */
rastPort := @rd^.renderPort;
//* clear our bitmap */
SetRast(rastPort, 0);
//* setup our maximum coordinates and our step width */
maxPos.x := rd^.backBufferSize.x - 1;
maxPos.y := rd^.backBufferSize.y - 1;
lineStep.x := maxPos.x div stepCount;
lineStep.y := maxPos.y div stepCount;
//* compute our current coordinates */
pos.x := rd^.currentStep * lineStep.x;
pos.y := rd^.currentStep * lineStep.y;
//* increase our step for the next frame */
rd^.currentStep := rd^.currentStep + 1;
if (rd^.currentStep >= stepCount) then
begin
rd^.currentStep := 0;
end;
//* now draw our line pattern */
SetAPen(rastPort, 1);
GfxMove(rastPort, 0, SLONG(pos.y));
Draw(rastPort, LongInt(maxPos.x - pos.x), 0 );
Draw(rastPort, LongInt(maxPos.x) , LongInt(maxPos.y - pos.y));
Draw(rastPort, LongInt(pos.x) , LongInt(maxPos.y) );
Draw(rastPort, 0 , LongInt(pos.y) );
end;
end;
As soon as currentStep becomes greater or equal to StepCount, we will have to reset the value back to 0 again.
The only thing left is to make sure that our RenderBackbuffer () is called regularly. In order to accomplish this we ignore the DoRender flag inside our loop and simply always draw in this situation.
The Wait() is replaced by a setsignal() and allows us to query if a message from the windows was received but without the need to wait for such a message to arrive.
function MainLoop(rd: PRenderEngineData): integer;
var
winport : PMsgPort;
winsig : ULONG;
signals : ULONG;
sig : ULONG;
msg : PMessage;
begin
//* remember the window port in a local variable for more easy use */
winport := rd^.window^.UserPort;
//* create our waitmask for the window port */
winSig := 1 shl winport^.mp_SigBit;
//* combine it with the CTRL-C signal */
signals := winSig or SIGBREAKF_CTRL_C;
//* paint our window for the first time */
rd^.doRender := TRUE;
//* we need to compute our output size initially */
ComputeOutputSize(rd);
//* enter our main loop */
while (rd^.run) do
begin
rd^.returnCode := RenderBackbuffer(rd);
if (rd^.returnCode = RETURN_OK) then
begin
//* Rendering succeeded, we need to repaint */
rd^.doRepaint := TRUE;
end
else
begin
//* Rendering failed, do not repaint.. */
rd^.doRepaint := FALSE;
//* but signal ourself to leave instead */
Signal(FindTask(nil), SIGBREAKF_CTRL_C);
end;
if (rd^.doRepaint) then
begin
RepaintWindow(rd);
rd^.doRepaint := FALSE;
end;
sig := SetSignal(0, signals);
if (sig and winSig) <> 0 then
begin
//* our window signaled us, so let's harvest all its messages in a loop... */
while true do
begin
msg := GetMsg(winport);
if not assigned(msg) then break;
//* ...and dispatch and reply each of them */
DispatchWindowMessage(rd, PIntuiMessage(msg));
ReplyMsg(msg);
end;
end;
if (sig and SIGBREAKF_CTRL_C) <> 0 then
begin
//* we leave on CTRL-C */
rd^.run := FALSE;
end;
end;
if Assigned(rd^.backBuffer) then
begin
MyFreeBitMap(rd^.backBuffer);
rd^.backBuffer := nil;
end;
result := rd^.returnCode;
end;
Here is the source engine4.pas, that can be compiled again with
fpc engine4.pas
[ you should be looking at a picture here ]
What's timer.device got to do with it
As expected, our window now shows an animation. However, in practice this implementation is far from ideal: On the one hand the speed of our animation directly dependents on the computing and graphical performance of the Amiga on which it runs and, on the other hand it will consume all the processor time that is available. So we need a different solution here. We could simply add a call to Delay() which at the least would sort out the problem with consuming CPU speed. However, if we want to display an animation with a single image every 2 seconds, it would cause the window to be blocked during those two seconds and as a result will respond very sluggish when clicking on the close button or other user actions. We would also need to take the time it takes to render and display into account and for that a simple Delay() is not suitable because of its 1/50-second resolution. We need another timer and timer.device provides one that is perfectly suited for our purposes.
Like any device, timer.device is also controlled by exec functions OpenDevice()/CloseDevice() and SendIO()/WaitIO()/DoIO()/AbortIO(). Additionally timer.device has a small set of functions that are called in a similar way as functions from a library. These functions are declared inside unit timer and require an initialized base pointer as for any library.
Note that unit timer already provides a variable named TimerBase for this purpose.
As it should be for any device, also timer.device is controlled by sending IORequests. These IORequests are generated by us and not by the device itself and in order to send these back and forth we also need a MsgPort. Timer.device also defines its own IORequest structure which is a structure named timerequest and is located in unit timer. In addition to the IORequest, there is also a structure TTimeval defined which supports timing with a resolution of microseconds (1/1000000 seconds).
Therefor we're going to expand our RenderEngineData structure, this time with a MsgPort and a timerequest:
timerPort : PMsgPort;
timerIO : Ptimerequest;
We also need to make sure the following two units are in our uses clause:
Uses
Exec, Timer;
We create our own function to open timer.device:
function InitTimerDevice(rd: PRenderEngineData): integer;
begin
//* we do not return success until we've opened the timer.device */
result := RETURN_FAIL;
//* create a message port through which we will communicate with the timer.device */
rd^.timerPort := CreatePort(nil, 0);
if Assigned(rd^.timerPort) then
begin
//* create a timerequest which we will we pass between the timer.device and ourself */
rd^.timerIO := Ptimerequest(CreateExtIO(rd^.timerPort, sizeof(Ttimerequest)));
if Assigned(rd^.timerIO) then
begin
//* open the timer.device */
if (OpenDevice(TIMERNAME, UNIT_MICROHZ, PIORequest(rd^.timerIO), 0) = 0) then
begin
//* Success: let's set the TimerBase so we can call timer.device's functions */
TimerBase := PLibrary(rd^.timerIO^.tr_node.io_Device);
result := RETURN_OK;
end;
end;
end;
if (result <> RETURN_OK) then
begin
//* in case of an error: cleanup immediatly */
FreeTimerDevice(rd);
end;
end;
And a corresponding function FreeTimerDevice():
procedure FreeTimerDevice(rd: PRenderEngineData);
begin
//* close the timer.device */
if Assigned(TimerBase) then
begin
CloseDevice(PIORequest(rd^.timerIO));
TimerBase := nil;
end;
//* free our timerequest */
if Assigned(rd^.timerIO) then
begin
DeleteExtIO(PIORequest(rd^.timerIO));
rd^.timerIO := nil;
end;
//* free our message port */
if Assigned(rd^.timerPort) then
begin
DeletePort(rd^.timerPort);
rd^.timerPort := nil;
end;
end;
An additional short explanation for UNIT_MICROHZ used above: Timer.device offers several different modes, which mainly differ in their used resolution and accuracy. The mode we use here is characteristic for its high resolution. However it is also quite inaccurate: If you use it to count seconds then you'll notice that it will deviate from a price clock after a few minutes. However, this shortcoming is not important for our purpose.
Anyhow, we call these functions immediately after the creation of our RenderEngineData and directly before its release respectively. Because we will send our timerequests asynchronously they are therefor not available for us at timer.device operations. Therefor we do not use our freshly created timerrequest but use it as a template only in order to retrieve the actual used request. For now we only need one for our timer, which we will also add to the RenderEngineData structure:
tickRequest : Ttimerequest;
We initialize this field by simply assigning the contents of TimerIO to it:
rd^.tickRequest := rd^.timerIO^;
Finally our RunEngine() that now looks like this:
function RunEngine: integer;
var
rd : PRenderEngineData;
newWindow : TNewWindow;
begin
//* as long we did not enter our main loop we report an error */
result := RETURN_ERROR;
//* allocate the memory for our runtime data and initialize it with zeros */
rd := PRenderEngineData(ExecAllocMem(sizeof(TRenderEngineData), MEMF_ANY or MEMF_CLEAR));
if assigned(rd) then
begin
result := InitTimerDevice(rd);
if (result = RETURN_OK) then
begin
with newWindow do
begin
LeftEdge := 0; TopEdge := 14;
Width := 320; Height := 160;
DetailPen := UBYTE(not(0)); BlockPen := UBYTE(not(0));
IDCMPFlags := IDCMP_CLOSEWINDOW or IDCMP_NEWSIZE or IDCMP_REFRESHWINDOW;
Flags := WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_SIMPLE_REFRESH or WFLG_SIZEBBOTTOM or WFLG_SIZEGADGET;
FirstGadget := nil; CheckMark := nil;
Title := 'Gfx Workshop';
Screen := nil;
BitMap := nil;
MinWidth := 96; MinHeight := 48;
MaxWidth := UWORD(not(0)); MaxHeight := UWORD(not(0));
WType := WBENCHSCREEN_f;
end;
//* setup our tick request */
rd^.tickRequest := rd^.timerIO^;
rd^.tickRequest.tr_node.io_Command := TR_ADDREQUEST;
//* now let's open our window */
rd^.window := OpenWindow(@newWindow);
if Assigned(rd^.window) then
begin
//* the main loop will run as long this is TRUE */
rd^.run := TRUE;
result := MainLoop(rd);
//* cleanup: close the window */
CloseWindow(rd^.window);
rd^.window := nil;
end;
FreeTimerDevice(rd);
end;
//* free our runtime data */
ExecFreeMem(rd, sizeof(TRenderEngineData));
rd := nil;
end;
end;
Inside Mainloop(), because we cannot leave our loop before a request is answered by timer.device, we have to remember whether or not the tickRequest is just waiting or not. We do this by using a simple boolean:
tickRequestPending : Boolean;
We also need to expand our wait mask and include the TimerPort:
//* create our waitmask for the timer port */
tickSig := 1 shl rd^.timerPort^.mp_SigBit;
//* combine them to our final waitmask */
signals := winSig or tickSig or SIGBREAKF_CTRL_C;
We don't have to set DoRender to true, we'll do that later when we receive our ticks.
Immediately before our main loop we send the first tick-request:
{*
we start with a no-time request so we receive a tick immediately
(we have to set 2 micros because of a bug in timer.device for 1.3)
*}
rd^.tickRequest.tr_time.tv_secs := 0;
rd^.tickRequest.tr_time.tv_micro := 2;
SendIO(PIORequest(@rd^.tickRequest));
tickRequestPending := TRUE;
Instead of using setsignal () we are now waiting properly for the arrival of window messages or timers.device ticks:
sig := Wait(signals);
When we receive a tick signal we send it immediately so that we can be signaled about a 1/25 second later:
if (sig and tickSig) <> 0 then
begin
//* our tickRequest signalled us, let's remove it from the replyport */
WaitIO(PIORequest(@rd^.tickRequest));
if (rd^.run) then
begin
//* if we are running then we immediately request another tick... */
rd^.tickRequest.tr_time.tv_secs := 0;
rd^.tickRequest.tr_time.tv_micro := 1000000 div 25;
SendIO(PIORequest(@rd^.tickRequest));
rd^.doRender := TRUE;
end
else
begin
//* ... if not we acknowledge that our tickRequest returned */
tickRequestPending := FALSE;
end;
end;
Only if we want to leave our main loop we set TickRequestPending to False instead, because we can now safely close the timer.device again.
We also check whether we want to leave the loop but still have a tick-request pending in which case it must be canceled.:
if (not(rd^.run) and tickRequestPending) then
begin
//* We want to leave, but there is still a tick request pending? Let's abort it */
AbortIO(PIORequest(@rd^.tickRequest));
end;
Now, if we compile and execute engine5.pas, we'll immediately see that our animation is now much more stable and smoother.
[ you should be looking at a picture here ]