瀏覽代碼

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

git-svn-id: trunk@49193 -
Károly Balogh 4 年之前
父節點
當前提交
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/fpmake.pp svneol=native#text/plain
 packages/qlunits/src/qdos.pas 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/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 svneol=native#text/plain
 packages/regexpr/Makefile.fpc svneol=native#text/plain
 packages/regexpr/Makefile.fpc svneol=native#text/plain
 packages/regexpr/Makefile.fpc.fpcmake 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
 This package contains interface units for QDOS, the operating system
 of Sinclair QL machines, clones and compatibles.
 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('qdos.pas');
     T:=P.Targets.AddUnit('qlfloat.pas');
     T:=P.Targets.AddUnit('qlfloat.pas');
+    T:=P.Targets.AddUnit('qlutil.pas');
+    T:=P.Targets.AddUnit('sms.pas');
 
 
     P.ExamplePath.Add('examples');
     P.ExamplePath.Add('examples');
     T:=P.Targets.AddExampleProgram('qlcube.pas');
     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_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_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_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_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_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';
 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.