← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/os2units/mmtk/dive.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/os2units/mmtk/dive.pas
 
1
{****************************************************************************
 
2
 
 
3
 
 
4
                             DIVE interface unit
 
5
                     FPC Pascal Runtime Library for OS/2
 
6
             Copyright (c) 1999-2000 by Karoly Balogh (aka Charlie/INQ)
 
7
 
 
8
 The FPC Pascal runtime library is distributed under the Library GNU Public
 
9
 License v2. So is this unit. The Library GNU Public License requires you to
 
10
 distribute the source code of this unit with any product that uses it.
 
11
 Because the EMX library isn't under the LGPL, we grant you an exception to
 
12
 this, and that is, when you compile a program with the Free Pascal Compiler,
 
13
 you do not need to ship source code with that program, AS LONG AS YOU ARE
 
14
 USING UNMODIFIED CODE! If you modify this code, you MUST change the next
 
15
 line:
 
16
 
 
17
 <This an official, unmodified Free Pascal source code file.>
 
18
 
 
19
 Send us your modified files, we can work together if you want!
 
20
 
 
21
 Free Pascal is distributed in the hope that it will be useful,
 
22
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 
23
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
24
 Library GNU General Public License for more details.
 
25
 
 
26
 You should have received a copy of the Library GNU General Public License
 
27
 along with Free Pascal; see the file COPYING.LIB.  If not, write to
 
28
 the Free Software Foundation, 59 Temple Place - Suite 330,
 
29
 Boston, MA 02111-1307, USA.
 
30
 
 
31
****************************************************************************}
 
32
 
 
33
Unit DIVE;
 
34
 
 
35
{Warning: This code is alfa. Future versions of this unit will propably
 
36
 not be compatible.}
 
37
 
 
38
Interface
 
39
 
 
40
Uses OS2Def, PMWin, MMBase;
 
41
 
 
42
Const Max_Dive_Instances = 64;
 
43
 
 
44
      DIVE_Success                       = $00000000;
 
45
      DIVE_Err_Invalid_Instance          = $00001000;
 
46
      DIVE_Err_Source_Format             = $00001001;
 
47
      DIVE_Err_Destination_Format        = $00001002;
 
48
      DIVE_Err_Blitter_Not_Setup         = $00001003;
 
49
      DIVE_Err_Insufficient_Length       = $00001004;
 
50
      DIVE_Err_Too_Many_Instances        = $00001005;
 
51
      DIVE_Err_No_Direct_Access          = $00001006;
 
52
      DIVE_Err_Not_Bank_Switched         = $00001007;
 
53
      DIVE_Err_Invalid_Bank_Number       = $00001008;
 
54
      DIVE_Err_FB_Not_Acquired           = $00001009;
 
55
      DIVE_Err_FB_Already_Acquired       = $0000100A;
 
56
      DIVE_Err_Acquire_Failed            = $0000100B;
 
57
      DIVE_Err_Bank_Switch_Failed        = $0000100C;
 
58
      DIVE_Err_Deacquire_Failed          = $0000100D;
 
59
      DIVE_Err_Invalid_Palette           = $0000100E;
 
60
      DIVE_Err_Invalid_Destination_RECTL = $0000100F;
 
61
      DIVE_Err_Invalid_Buffer_Number     = $00001010;
 
62
      DIVE_Err_SSMDD_Not_Installed       = $00001011;
 
63
      DIVE_Err_Buffer_Already_Accessed   = $00001012;
 
64
      DIVE_Err_Buffer_Not_Accessed       = $00001013;
 
65
      DIVE_Err_Too_Many_Bufffers         = $00001014;
 
66
      DIVE_Err_Allocation_Error          = $00001015;
 
67
      DIVE_Err_Invalid_Linesize          = $00001016;
 
68
      DIVE_Err_Fatal_Exception           = $00001017;
 
69
      DIVE_Err_Invalid_Conversion        = $00001018;
 
70
      DIVE_Err_VSD_Error                 = $00001019;
 
71
      DIVE_Err_Color_Support             = $0000101A;
 
72
      DIVE_Err_Out_Of_Range              = $0000101B;
 
73
      DIVE_Warn_No_Size                  = $00001100;
 
74
 
 
75
      DIVE_Buffer_Screen                 = $00000000;
 
76
      DIVE_Buffer_Graphics_Plane         = $00000001;
 
77
      DIVE_Buffer_Alternate_Plane        = $00000002;
 
78
 
 
79
      DIVE_Fully_Visible                 = $FFFFFFFF;
 
80
 
 
81
      { * Use either of the two defines as the bRGB2Entries pointer to have DIVE  * }
 
82
      { * query and set the physical or default palette as source or destination. * }
 
83
 
 
84
      DIVE_Palette_Physical = $00000000;
 
85
      DIVE_Palette_Default  = $FFFFFFFF;
 
86
 
 
87
Type  HDIVE  = cardinal;
 
88
 
 
89
      { * Blitter setup structures * }
 
90
      TSetup_Blitter = Record
 
91
        ulStructLen : cardinal; { * ulStructLen tells how much of the structure is used.     * }
 
92
                             { * Comments here show appropriate values, so don't count ;) * }
 
93
 
 
94
        fInvert     : cardinal; { * Image is inverted on blit * }
 
95
                             { * fInvert use: * }
 
96
                             { * %0001 = 01 = $01 horizontal flip * }
 
97
                             { * %0010 = 02 = $02 vertical flip   * }
 
98
 
 
99
        { * This is the mark for 8 bytes * }
 
100
 
 
101
        fccSrcColorFormat : FourCC;   { * Source data format * }
 
102
        ulSrcWidth        : cardinal;    { * Width in pels  * }
 
103
        ulSrcHeight       : cardinal;    { * Height in pels * }
 
104
                                      { * The following are for displaying a sub-portion of the image. * }
 
105
        ulSrcPosX         : cardinal;    { * X Position of source data * }
 
106
        ulSrcPosY         : cardinal;    { * Y Position of source data * }
 
107
 
 
108
        { * This is the mark for 28 bytes * }
 
109
 
 
110
        ulDitherType      : cardinal;    { * Dither type * }
 
111
 
 
112
        { * 32 byte mark * }
 
113
 
 
114
        fccDstColorFormat : FourCC;   { * Destination color format   * }
 
115
        ulDstWidth        : cardinal;    { * Destination width in pels  * }
 
116
        ulDstHeight       : cardinal;    { * Destination height in pels * }
 
117
        lDstPosX          : LongInt;
 
118
        lDstPosY          : LongInt;
 
119
 
 
120
        { * 52 byte mark * }
 
121
 
 
122
        lScreenPosX       : LongInt;
 
123
        lScreenPosY       : LongInt;
 
124
 
 
125
        { * 60 byte mark * }
 
126
 
 
127
        ulNumDstRects     : cardinal;
 
128
        pVisDstRects      : PRectl; { * This is a pointer to an array of visible rectangles. * }
 
129
 
 
130
        { * 68 bytes = fully used * }
 
131
       End;
 
132
 
 
133
      PSetup_Blitter = ^TSetup_Blitter;
 
134
 
 
135
      { * Stuff for DiveQueryCaps() * }
 
136
      TDIVE_CAPS = Record
 
137
        ulStructLen   : cardinal;  { * SizeOf(TDIVE_CAPS)       * }
 
138
        ulPlaneCount  : cardinal;  { * Number of defined planes * }
 
139
 
 
140
        { * Following info applies to ulPlaneID * }
 
141
        fScreenDirect : Boolean;  { * Direct screen access (was type BOOL in C) * }
 
142
        fBankSwitched : Boolean;  { * VRAM bank-switched? (was type BOOL in C) * }
 
143
        ulDepth       : cardinal;  { * Number of bits per pixel * }
 
144
        ulHorizontalResolution : cardinal;
 
145
        ulVerticalResolution   : cardinal;
 
146
        ulScanLineBytes        : cardinal;
 
147
        fccColorEncoding       : FourCC;
 
148
        ulApertureSize         : cardinal;
 
149
 
 
150
        ulInputFormats   : cardinal;   { * Number of input color formats * }
 
151
        ulOutputFormats  : cardinal;
 
152
        ulFormatLength   : cardinal;   { * Length of format buffer * }
 
153
        pFormatData      : Pointer; { * Pointer to format buffer of FOURCC's * }
 
154
       End;
 
155
 
 
156
      PDIVE_CAPS = ^TDIVE_CAPS;
 
157
 
 
158
Function DiveQueryCaps(DiveCaps: PDIVE_CAPS; ulPlaneBufNum : cardinal) : cardinal; cdecl;
 
159
 
 
160
Function DiveOpen(Var phDiveInst : cardinal; fNonScreenInstance : cardinal;
 
161
                  Var ppFrameBuffer : Pointer) : cardinal; cdecl;
 
162
Function DiveClose(hDiveInst : cardinal) : cardinal; cdecl;
 
163
 
 
164
Function DiveSetupBlitter(hDiveInst : cardinal; pSetupBlitter : PSetup_Blitter) : cardinal; cdecl;
 
165
Function DiveBlitImage(hDiveInst : cardinal; ulSrcBufNumber : cardinal; ulDstBufNumber : cardinal) : cardinal; cdecl;
 
166
 
 
167
Function DiveAcquireFrameBuffer(hDiveInst : cardinal; prectlDst : PRectl) : cardinal; cdecl;
 
168
Function DiveDeacquireFrameBuffer(hDiveInst : cardinal) : cardinal; cdecl;
 
169
Function DiveCalcFrameBufferAddress(hDiveInst           : cardinal;
 
170
                                    prectlDest          : PRectl;
 
171
                                Var pDestinationAddress : Pointer;
 
172
                                Var ulBankNumber        : cardinal;
 
173
                                Var ulRemLinesInBank    : cardinal) : cardinal; cdecl;
 
174
Function DiveSwitchBank(hDiveInst : cardinal; ulBankNumber : cardinal) : cardinal; cdecl;
 
175
 
 
176
{ Notes on DiveAllocImageBuffer:
 
177
  If pbImageBuffer is not NULL, the buffer is associated rather than
 
178
  allocated.  If pbImageBuffer is not NULL and the buffer number
 
179
  pointed to by pulBufferNumber is non-zero, a new buffer pointer is
 
180
  associated with the buffer number.  Even though no memory is
 
181
  allocated by DiveAllocImageBuffer when user-allocated buffers are
 
182
  associated, DiveFreeImageBuffer should be called to release the
 
183
  buffer association to avoid using up available buffer indexes.
 
184
  The specified line size will be used if a buffer is allocated in
 
185
  system memory, or if a user buffer is associated.  If the
 
186
  specified line size is zero, the allocated line size is rounded up
 
187
  to the nearest DWORD boundry. }
 
188
 
 
189
Function DiveAllocImageBuffer(hDiveInst       : cardinal;
 
190
                          Var ulBufferNumber  : cardinal;
 
191
                              fccColorSpace   : FourCC;
 
192
                              ulWidth         : cardinal;
 
193
                              ulHeight        : cardinal;
 
194
                              ulLineSizeBytes : cardinal;
 
195
                          Var bImageBuffer    : Pointer) : cardinal; cdecl;
 
196
Function DiveFreeImageBuffer(hDiveInst : cardinal; ulBufferNumber : cardinal) : cardinal; cdecl;
 
197
 
 
198
Function DiveBeginImageBufferAccess(hDiveInst              : cardinal;
 
199
                                    ulBufferNumber         : cardinal;
 
200
                                Var pbImageBuffer          : Pointer;
 
201
                                Var ulBufferScanLineBytes  : cardinal;
 
202
                                Var ulBufferScanLines      : cardinal) : cardinal; cdecl;
 
203
Function DiveEndImageBufferAccess(hDiveInst : cardinal; ulBufferNumber : cardinal) : cardinal; cdecl;
 
204
 
 
205
 
 
206
{/* Notes on palettes:
 
207
      Neither DiveSetSourcePalette nor DiveSetDestinationPalette API's will set
 
208
      the physical palette.  If your application MUST set the PHYSICAL palette,
 
209
      try using no more than 236 entries (the middle 236: 10-245, thus leaving
 
210
      the top and bottom 10 entries for the Workplace Shell).  If your
 
211
      application MUST use ALL 256 entries, it must do so as a full-screen
 
212
      (i.e. maximized) application.  Remember, No WM_REALIZEPALETTE message
 
213
      will be sent to other running applications, meaning they will not redraw
 
214
      and their colors will be all wrong.  It is not recommended that a
 
215
      developer use these commands:
 
216
 
 
217
   To set physical palette, do the following:
 
218
            hps = WinGetPS ( HWND_DESKTOP );
 
219
            hdc = GpiQueryDevice ( hps );
 
220
            GpiCreateLogColorTable ( hps, LCOL_PURECOLOR | LCOL_REALIZABLE,
 
221
                           LCOLF_CONSECRGB, 0, 256, (PLONG)plRGB2Entries );
 
222
            Gre32EntrY3 ( hdc, 0L, 0x000060C6L );
 
223
            WinInvalidateRect ( HWND_DESKTOP, (PRECTL)NULL, TRUE );
 
224
            WinReleasePS ( hps );
 
225
 
 
226
   To reset physical palette, do the following:
 
227
            hps = WinGetPS ( HWND_DESKTOP );
 
228
            hdc = GpiQueryDevice ( hps );
 
229
            Gre32EntrY3 ( hdc, 0L, 0x000060C7L );
 
230
            WinInvalidateRect ( HWND_DESKTOP, (PRECTL)NULL, TRUE );
 
231
            WinReleasePS ( hps );
 
232
*/}
 
233
 
 
234
Function DiveSetDestinationPalette(hDiveInst    : cardinal;
 
235
                                   ulStartIndex : cardinal;
 
236
                                   ulNumEntries : cardinal;
 
237
                               Var bRGB2Entries : Pointer) : cardinal; cdecl;
 
238
 
 
239
Function DiveSetSourcePalette(hDiveInst    : cardinal;
 
240
                              ulStartIndex : cardinal;
 
241
                              ulNumEntries : cardinal;
 
242
                          Var bRGB2Entries : Pointer) : cardinal; cdecl;
 
243
 
 
244
Function DiveSetTransparentBlitMode(hDiveInst    : cardinal;
 
245
                                    ulStartIndex : cardinal;
 
246
                                    ulValue1     : cardinal;
 
247
                                    ulValue2     : cardinal) : cardinal; cdecl;
 
248
 
 
249
Implementation
 
250
 
 
251
Function DiveQueryCaps(DiveCaps : PDIVE_CAPS; ulPlaneBufNum : cardinal) : cardinal; cdecl;
 
252
External 'DIVE' Index 1;
 
253
 
 
254
Function DiveOpen(Var phDiveInst : cardinal; fNonScreenInstance : cardinal; Var ppFrameBuffer : Pointer) : cardinal; cdecl;
 
255
External 'DIVE' Index 2;
 
256
 
 
257
Function DiveClose(hDiveInst : cardinal) : cardinal; cdecl;
 
258
External 'DIVE' Index 3;
 
259
 
 
260
Function DiveSetupBlitter(hDiveInst : cardinal; pSetupBlitter : PSetup_Blitter) : cardinal; cdecl;
 
261
External 'DIVE' Index 4;
 
262
 
 
263
Function DiveBlitImage(hDiveInst : cardinal; ulSrcBufNumber : cardinal; ulDstBufNumber : cardinal) : cardinal; cdecl;
 
264
External 'DIVE' Index 5;
 
265
 
 
266
Function DiveAcquireFrameBuffer(hDiveInst : cardinal; prectlDst : PRectl) : cardinal; cdecl;
 
267
External 'DIVE' Index 6;
 
268
 
 
269
Function DiveDeacquireFrameBuffer(hDiveInst : cardinal) : cardinal; cdecl;
 
270
External 'DIVE' Index 8;
 
271
 
 
272
Function DiveCalcFrameBufferAddress(hDiveInst           : cardinal;
 
273
                                    prectlDest          : PRectl;
 
274
                                Var pDestinationAddress : Pointer;
 
275
                                Var ulBankNumber        : cardinal;
 
276
                                Var ulRemLinesInBank    : cardinal) : cardinal; cdecl;
 
277
External 'DIVE' Index 11;
 
278
 
 
279
Function DiveSwitchBank(hDiveInst : cardinal; ulBankNumber : cardinal) : cardinal; cdecl;
 
280
External 'DIVE' Index 7;
 
281
 
 
282
 
 
283
Function DiveAllocImageBuffer(hDiveInst       : cardinal;
 
284
                          Var ulBufferNumber  : cardinal;
 
285
                              fccColorSpace   : FourCC;
 
286
                              ulWidth         : cardinal;
 
287
                              ulHeight        : cardinal;
 
288
                              ulLineSizeBytes : cardinal;
 
289
                          Var bImageBuffer    : Pointer) : cardinal; cdecl;
 
290
External 'DIVE' Index 12;
 
291
 
 
292
Function DiveFreeImageBuffer(hDiveInst      : cardinal;
 
293
                             ulBufferNumber : cardinal) : cardinal; cdecl;
 
294
External 'DIVE' Index 13;
 
295
 
 
296
Function DiveBeginImageBufferAccess(hDiveInst              : cardinal;
 
297
                                    ulBufferNumber         : cardinal;
 
298
                                Var pbImageBuffer          : Pointer;
 
299
                                Var ulBufferScanLineBytes  : cardinal;
 
300
                                Var ulBufferScanLines      : cardinal) : cardinal; cdecl;
 
301
External 'DIVE' Index 14;
 
302
 
 
303
Function DiveEndImageBufferAccess(hDiveInst : cardinal; ulBufferNumber : cardinal) : cardinal; cdecl;
 
304
External 'DIVE' Index 15;
 
305
 
 
306
Function DiveSetDestinationPalette(hDiveInst    : cardinal;
 
307
                                   ulStartIndex : cardinal;
 
308
                                   ulNumEntries : cardinal;
 
309
                               Var bRGB2Entries : Pointer) : cardinal; cdecl;
 
310
External 'DIVE' Index 9;
 
311
 
 
312
Function DiveSetSourcePalette(hDiveInst    : cardinal;
 
313
                              ulStartIndex : cardinal;
 
314
                              ulNumEntries : cardinal;
 
315
                          Var bRGB2Entries : Pointer) : cardinal; cdecl;
 
316
External 'DIVE' Index 10;
 
317
 
 
318
Function DiveSetTransparentBlitMode(hDiveInst    : cardinal;
 
319
                                    ulStartIndex : cardinal;
 
320
                                    ulValue1     : cardinal;
 
321
                                    ulValue2     : cardinal) : cardinal; cdecl;
 
322
External 'DIVE' Index 18;
 
323
 
 
324
End.