Bläddra i källkod

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

git-svn-id: trunk@49193 -
Károly Balogh 4 år sedan
förälder
incheckning
a6d475b9b3

+ 2 - 0
.gitattributes

@@ -8789,6 +8789,8 @@ packages/qlunits/examples/qlcube.pas svneol=native#text/plain
 packages/qlunits/fpmake.pp svneol=native#text/plain
 packages/qlunits/src/qdos.pas svneol=native#text/plain
 packages/qlunits/src/qlfloat.pas svneol=native#text/plain
+packages/qlunits/src/qlutil.pas svneol=native#text/plain
+packages/qlunits/src/sms.pas svneol=native#text/plain
 packages/regexpr/Makefile svneol=native#text/plain
 packages/regexpr/Makefile.fpc svneol=native#text/plain
 packages/regexpr/Makefile.fpc.fpcmake svneol=native#text/plain

+ 11 - 0
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

+ 2 - 0
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');

+ 3 - 0
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';

+ 54 - 0
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.

+ 30 - 0
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.