tosunits: early bits for some VDI bindings

git-svn-id: trunk@37787 -

.gitattributes

@@ -7552,6 +7552,7 @@ packages/tosunits/examples/higem.pas svneol=native#text/plain
 packages/tosunits/fpmake.pp svneol=native#text/plain
 packages/tosunits/src/aes.pas svneol=native#text/plain
 packages/tosunits/src/gemdos.pas svneol=native#text/plain
+packages/tosunits/src/vdi.pas svneol=native#text/plain
 packages/tosunits/src/xbios.pas svneol=native#text/plain
 packages/univint/Makefile svneol=native#text/plain
 packages/univint/Makefile.fpc svneol=native#text/plain

packages/tosunits/fpmake.pp

@@ -29,6 +29,7 @@ begin
 
     T:=P.Targets.AddUnit('gemdos.pas');
     T:=P.Targets.AddUnit('xbios.pas');
+    T:=P.Targets.AddUnit('vdi.pas');
     T:=P.Targets.AddUnit('aes.pas');
 
     P.ExamplePath.Add('examples');

packages/tosunits/src/vdi.pas

@@ -0,0 +1,230 @@
+{
+    Copyright (c) 2017 by Free Pascal development team
+
+    VDI interface unit for Atari TOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit vdi;
+
+interface
+
+{ The API description of this file is based on the information available
+  online at: http://toshyp.atari.org }
+
+type
+  PCOLOR_RGB = ^TCOLOR_RGB;
+  TCOLOR_RGB = record
+      reserved: word;     {* Set to 0 or the index of the entry *}
+      red: word;          {* Red:   0<->65535 *}
+      green: word;        {* Green: 0<->65535 *}
+      blue: word;         {* Blue:  0<->65535 *}
+  end;
+
+{$WARNING type TCOLOR_ENTRY is incomplete}
+type
+  TCOLOR_ENTRY = record
+    case byte of
+      0: ( rgb: TCOLOR_RGB; );
+      1: ( cymk: array[0..1] of longint; ); // dummy
+  end;
+
+type
+  PCOLOR_TAB = ^TCOLOR_TAB;
+  TCOLOR_TAB = record             {* Colour table                    *}
+      magic: array[0..3] of char; {* 'ctab'                          *}
+      length: longint;
+      format: longint;            {* Format (0)                      *}
+      reserved: longint;          {* Reserved, set to 0              *}
+      map_id: longint;            {* Colour table ID                 *}
+      color_space: longint;       {* Colour space (at present only
+                                     CSPACE_RGB)                     *}
+      flags: longint;             {* VDI-internal flags, set to 0    *}
+      no_colors: longint;         {* Number of colour entries        *}
+      reserved1: longint;         {* Reserved, must be 0             *}
+      reserved2: longint;         {* Reserved, must be 0             *}
+      reserved3: longint;         {* Reserved, must be 0             *}
+      reserved4: longint;         {* Reserved, must be 0             *}
+      colors: array[0..0] of TCOLOR_ENTRY; { repeated no_colors times }
+  end;
+
+type
+  PPOINT16 = ^TPOINT16;
+  TPOINT16 = record               {* Point for 16-bit coordinates *}
+      x: smallint;
+      y: smallint;
+  end;
+
+type
+  PPOINT32 = ^TPOINT32;
+  TPOINT32 = record               {* Point for 32-bit coordinates *}
+      x: longint;
+      y: longint;
+  end;
+
+type
+  PRECT16 = ^TRECT16;
+  TRECT16 = record                {* Rectangle for 16-bit coordinates *}
+      x1: smallint;
+      y1: smallint;
+      x2: smallint;
+      y2: smallint;
+  end;
+
+type
+  PRECT32 = ^TRECT32;
+  TRECT32 = record                {* Rectangle for 32-bit coordinates *}
+      x1: longint;
+      y1: longint;
+      x2: longint;
+      y2: longint;
+  end;
+
+type
+  PMFDB = ^TMFDB;
+  TMFDB = record
+      fd_addr: pointer;          {* Pointer to the start of the
+                                    memory block, e.g. the
+                                    screen memory base address  *}
+      fd_w: smallint;            {* Width in pixels             *}
+      fd_h: smallint;            {* Height in pixels            *}
+      fd_wdwidth: smallint;      {* Width of a line in words    *}
+      fd_stand: smallint;        {* 0 = Device-specific format  *}
+                                 {* 1 = Standard format         *}
+      fd_nplanes: smallint;      {* Number of planes            *}
+      fd_r1: smallint;           {* Reserved, must be 0         *}
+      fd_r2: smallint;           {* Reserved, must be 0         *}
+      fd_r3: smallint;           {* Reserved, must be 0         *}
+  end;
+
+type
+  PVDIContrl = ^TVDIContrl;
+  TVDIContrl = array[0..11] of smallint;
+
+  PVDIPtsIn  = ^TVDIPtsIn;
+  TVDIPtsIn  = array[0..1023] of smallint;
+
+  PVDIPtsOut = ^TVDIPtsOut;
+  TVDIPtsOut = array[0..255] of smallint;
+
+  PVDIIntIn  = ^TVDIIntIn;
+  TVDIIntIn  = array[0..1023] of smallint;
+
+  PVDIIntOut = ^TVDIIntOut;
+  TVDIIntOut = array[0..511] of smallint;
+
+type
+  PVDIPB = ^TVDIPB;
+  TVDIPB = record
+      contrl: PVDIContrl;        {* Pointer to contrl array *}
+      intin: PVDIIntIn;          {* Pointer to intin array  *}
+      ptsin: PVDIPtsIn;          {* Pointer to ptsin array  *}
+      intout: PVDIIntOut;        {* Pointer to intout array *}
+      ptsout: PVDIPtsOut;        {* Pointer to ptsout array *}
+  end;
+
+const
+  VDI_TRAP_MAGIC = $73;
+
+procedure vdi;
+
+procedure vdi_str_to_pchar(src: psmallint; des: pchar; len: smallint);
+function pchar_str_to_vdi(src: pchar; des: psmallint): longint;
+
+procedure v_pline(handle: smallint; count: smallint; pxyarray: psmallint);
+
+procedure v_get_pixel(handle: smallint; x: smallint; y: smallint;
+                      pel: psmallint; index: psmallint);
+
+
+implementation
+
+var
+  _contrl: TVDIContrl;
+  _intin: TVDIIntIn;
+  _intout: TVDIIntOut;
+  _ptsin: TVDIPtsIn;
+  _ptsout: TVDIPtsOut;
+
+const
+  pblock: TVDIPB = (
+    contrl: @_contrl;
+    intin: @_intin;
+    ptsin: @_ptsin;
+    intout: @_intout;
+    ptsout: @_ptsout;
+  );
+
+procedure vdi; assembler;
+asm
+  lea.l pblock, a0
+  move.l a0, d1
+  move.w #VDI_TRAP_MAGIC, d0
+  trap #2
+end;
+
+procedure vdi_str_to_pchar(src: psmallint; des: pchar; len: smallint);
+begin
+  while len > 0 do
+    begin
+      des[0]:=char(src[0]); {* Only low byte *}
+      inc(src);
+      inc(des);
+      dec(len);
+    end;
+  des[0]:=#0; {* End of string *}
+end;
+
+function pchar_str_to_vdi(src: pchar; des: psmallint): longint;
+var
+  len: longint;
+begin
+  len:=0;
+  repeat
+    des[len]:=ord(src[len]);
+    inc(len);
+  until (src[len-1] = #0);
+
+  pchar_str_to_vdi:=len-1;
+end;
+
+procedure v_pline(handle: smallint; count: smallint; pxyarray: psmallint);
+begin
+  //  _ptsin[0..2*count-1] = pxyarray[0..2*count-1];
+  move(pxyarray^,_ptsin,count*2*sizeof(smallint));
+
+  _contrl[0]:=6;
+  _contrl[1]:=count;
+  _contrl[3]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+end;
+
+procedure v_get_pixel(handle: smallint; x: smallint; y: smallint;
+                      pel: psmallint; index: psmallint);
+begin
+  _ptsin[0]:=x;
+  _ptsin[0]:=x;
+  _ptsin[1]:=y;
+  _contrl[0]:=105;
+  _contrl[1]:=1;
+  _contrl[3]:=0;
+  _contrl[6]:=handle;
+
+  vdi;
+
+  pel^:=_intout[0];
+  index^:=_intout[1];
+end;
+
+
+
+end.