فهرست منبع

qlunits: really add the a new example missed from the previous commit

git-svn-id: trunk@49311 -
Károly Balogh 4 سال پیش
والد
کامیت
6a35227a50
2فایلهای تغییر یافته به همراه54 افزوده شده و 0 حذف شده
  1. 1 0
      .gitattributes
  2. 53 0
      packages/qlunits/examples/mtinf.pas

+ 1 - 0
.gitattributes

@@ -8814,6 +8814,7 @@ packages/pxlib/src/pxlib.pp svneol=native#text/plain
 packages/qlunits/Makefile svneol=native#text/plain
 packages/qlunits/Makefile svneol=native#text/plain
 packages/qlunits/Makefile.fpc svneol=native#text/plain
 packages/qlunits/Makefile.fpc svneol=native#text/plain
 packages/qlunits/README.txt svneol=native#text/plain
 packages/qlunits/README.txt svneol=native#text/plain
+packages/qlunits/examples/mtinf.pas svneol=native#text/plain
 packages/qlunits/examples/qlcube.pas svneol=native#text/plain
 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

+ 53 - 0
packages/qlunits/examples/mtinf.pas

@@ -0,0 +1,53 @@
+{
+    Copyright (c) 2021 Karoly Balogh
+
+    System info/System variables access on a Sinclair QL
+    Example program for Free Pascal's Sinclair QL support
+
+    This example program is in the Public Domain under the terms of
+    Unlicense: http://unlicense.org/
+
+ **********************************************************************}
+
+program mtinf;
+
+uses
+  qdos;
+
+type
+  Tver = array[0..3] of char;
+
+var
+  job_id: longint;
+  ver_ascii: longint;
+  system_vars: pbyte;
+
+function get_id_str(const id: dword): string;
+const
+  QDOS = $D2540000;
+  SMS = $53324154; { S2AT }
+  SMSQ = $534D5351; { SMSQ }
+  ARGOS_THOR = $DC010000;
+begin
+  case id of
+    QDOS: get_id_str:='QDOS';
+    SMS: get_id_str:='SMS';
+    SMSQ: get_id_str:='SMSQ';
+    ARGOS_THOR: get_id_str:='Thor (ARGOS)';
+  else
+    get_id_str:='unknown ($'+hexstr(id,8)+')';
+  end;
+end;
+
+begin
+  job_id:=mt_inf(@system_vars,@ver_ascii);
+
+  writeln('Job ID:',lo(job_id),' Tag:',hi(job_id));
+  writeln('Identification: ',get_id_str(pdword(@system_vars[SV_IDENT])^));
+  writeln('Version: ',Tver(ver_ascii));
+
+  writeln('System vars are at: $',hexstr(system_vars));
+  writeln('Processor type: 680',hexstr(system_vars[SV_PTYP],2));
+  writeln('Monitor mode: ',system_vars[SV_TVMOD]);
+  writeln('Random number: ',pword(@system_vars[SV_RAND])^);
+end.