qlunits: updates, new API and utility functions, improved README

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49193 3ad0048d-3df7-0310-abae-a5850022a9f2

5 files changed, 100 insertions, 0 deletions

diff --git a/packages/qlunits/README.txt b/packages/qlunits/README.txt
index b5d7cd9bd9..72caa5e3b2 100644
--- a/packages/qlunits/README.txt
+++ b/packages/qlunits/README.txt
@@ -1,2 +1,13 @@
 This package contains interface units for QDOS, the operating system
 of Sinclair QL machines, clones and compatibles.
+
+The following units are available:
+
+    qdos - allows the use of QDOS API directly
+    sms - allows the use of SMS API directly
+    qlutils - utility functions for better QL API to Pascal interoperability
+    qlfloat - utility functions to convert between Pascal numeric types and QLfloats
+
+The following examples are available:
+
+    qlcube - draws a 3D rotating wireframe cube with QDOS drawing functions
diff --git a/packages/qlunits/fpmake.pp b/packages/qlunits/fpmake.pp
index 311dc5b1c8..662f0a9cd6 100644
--- a/packages/qlunits/fpmake.pp
+++ b/packages/qlunits/fpmake.pp
@@ -30,6 +30,8 @@ begin
 
     T:=P.Targets.AddUnit('qdos.pas');
     T:=P.Targets.AddUnit('qlfloat.pas');
+    T:=P.Targets.AddUnit('qlutil.pas');
+    T:=P.Targets.AddUnit('sms.pas');
 
     P.ExamplePath.Add('examples');
     T:=P.Targets.AddExampleProgram('qlcube.pas');
diff --git a/packages/qlunits/src/qdos.pas b/packages/qlunits/src/qdos.pas
index 7bba75418e..f8bbeb194c 100644
--- a/packages/qlunits/src/qdos.pas
+++ b/packages/qlunits/src/qdos.pas
@@ -106,7 +106,10 @@ function io_sstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): lo
 function fs_posab(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posab';
 function fs_posre(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posre';
 function fs_headr(chan: Tchanid; buf: pointer; buf_size: word): longint; external name '_fs_headr';
+function fs_rename_qlstr(chan: Tchanid; new_name_as_qlstr: pointer): longint; external name '_fs_rename_qlstr';
+function fs_rename(chan: Tchanid; new_name: pchar): longint; external name '_fs_rename';
 function fs_truncate(chan: Tchanid): longint; external name '_fs_truncate';
+function fs_mkdir(chan: Tchanid): longint; external name '_iof_mkdr'; { SMS }
 
 function sd_wdef(chan: Tchanid; timeout: Ttimeout; border_colour: byte; border_width: word; window: PQLRect): longint; external name '_sd_wdef'; 
 function sd_clear(chan: Tchanid; timeout: Ttimeout): longint; external name '_sd_clear';
diff --git a/packages/qlunits/src/qlutil.pas b/packages/qlunits/src/qlutil.pas
new file mode 100644
index 0000000000..660bcc4077
--- /dev/null
+++ b/packages/qlunits/src/qlutil.pas
@@ -0,0 +1,54 @@
+{
+    This file is part of the Free Pascal Sinclair QL support package.
+    Copyright (c) 2021 by Karoly Balogh
+
+    Interface QDOS OS functions for applications
+
+    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.
+
+ **********************************************************************}
+{$MODE FPC}
+unit qlutil;
+
+interface
+
+procedure toqlstring(const s: ansistring; qlstring: pointer; qlstrbuflen: longint);
+function toqlstring(const s: ansistring): pointer;
+
+implementation
+
+
+procedure toqlstring(const s: ansistring; qlstring: pointer; qlstrbuflen: longint);
+var
+  len: longint;
+begin
+  len:=length(s);
+  if len > qlstrbuflen-sizeof(word) then
+    len:=qlstrbuflen-sizeof(word);
+
+  if assigned(qlstring) then
+    begin
+      pword(qlstring)[0]:=len;
+      move(s[1],pword(qlstring)[1],len);
+    end;
+end;
+
+function toqlstring(const s: ansistring): pointer;
+var
+  qlstring: pointer;
+begin
+  qlstring:=GetMem(length(s)+sizeof(word));
+  if assigned(qlstring) then
+    begin
+      pword(qlstring)[0]:=length(s);
+      move(s[1],pword(qlstring)[1],length(s));
+    end;
+  toqlstring:=qlstring;
+end;
+
+end.
diff --git a/packages/qlunits/src/sms.pas b/packages/qlunits/src/sms.pas
new file mode 100644
index 0000000000..9f28f3d2b4
--- /dev/null
+++ b/packages/qlunits/src/sms.pas
@@ -0,0 +1,30 @@
+{
+    This file is part of the Free Pascal Sinclair QL support package.
+    Copyright (c) 2021 by Karoly Balogh
+
+    Interface to SMS only OS functions used by the Sinclair QL RTL
+
+    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 sms;
+
+
+interface
+
+uses
+  qdos;
+
+
+function iof_mkdr(chan: Tchanid): longint; external name '_iof_mkdr';
+
+implementation
+
+
+end.