tosunits: added another example which shows a DEGAS format picture

git-svn-id: trunk@45474 -

.gitattributes

@@ -9035,6 +9035,8 @@ packages/tosunits/README.txt svneol=native#text/plain
 packages/tosunits/examples/gemcube.pas svneol=native#text/plain
 packages/tosunits/examples/gemwin.pas svneol=native#text/plain
 packages/tosunits/examples/higem.pas svneol=native#text/plain
+packages/tosunits/examples/showpic.inc svneol=native#text/plain
+packages/tosunits/examples/showpic.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/examples/showpic.pas

@@ -0,0 +1,75 @@
+{
+    Copyright (c) 2020 Karoly Balogh
+
+    Shows an Atari DEGAS picture on full screen
+    Example program for Free Pascal's Atari TOS bindings
+
+    This example program is in the Public Domain under the terms of
+    Unlicense: http://unlicense.org/
+
+ **********************************************************************}
+
+{$APPTYPE CONSOLE}
+program showpic;
+
+uses
+  xbios, gemdos;
+
+{$i showpic.inc}
+
+type
+  Tdegas_picture = record
+    mode: smallint;
+    palette: array[0..15] of smallint;
+    data: array[0..31999] of byte;
+  end;
+  Pdegas_picture = ^Tdegas_picture;
+
+var
+  old_palette: array[0..16] of smallint;
+  old_rez: smallint;
+  screen: pword;
+  pic: Pdegas_picture;
+
+procedure save_palette(palette: pword);
+var
+  i: smallint;
+begin
+  for i:=0 to 15 do
+    palette[i]:=xbios_setcolor(i,-1);
+end;
+
+procedure init(mode: smallint);
+begin
+  { obtain the old resolution and palette }
+  old_rez:=xbios_getrez;
+  save_palette(@old_palette[0]);
+
+  { set the screen mode and get the framebuffer address }
+  xbios_setscreen(pointer(-1),pointer(-1),mode);
+  screen:=xbios_logbase;
+end;
+
+procedure done;
+begin
+  { restore original screen resolution and palette }
+  xbios_setscreen(pointer(-1),pointer(-1),old_rez);
+  xbios_setpalette(@old_palette);
+end;
+
+begin
+  { this uses a compiled-in picture, but it's easy to load
+    something from disk at this point instead }
+  pic:=Pdegas_picture(@cheetah_pic);
+
+  init(pic^.mode);
+
+  { set the palette and move picture data to the framebuffer }
+  xbios_setpalette(@pic^.palette);
+  system.move(pic^.data,screen^,sizeof(pic^.data));
+
+  { wait for keypress }
+  gemdos_cnecin;
+
+  done;
+end.

packages/tosunits/fpmake.pp

@@ -37,6 +37,7 @@ begin
     T:=P.Targets.AddExampleProgram('higem.pas');
     T:=P.Targets.AddExampleProgram('gemwin.pas');
     T:=P.Targets.AddExampleProgram('gemcube.pas');
+    T:=P.Targets.AddExampleProgram('showpic.pas');
 
 {$ifndef ALLPACKAGES}
     Run;