Browse Source

* Gameunit, Fpctris and samegame fixed for win32 GUI

marco 24 years ago
parent
commit
0efccccf3b

+ 2 - 0
demo/graph/fpcgames.txt

@@ -174,6 +174,7 @@ v0.08 - FileMode in GameUnit fixed.
          checks on.
       - Graph mode implemented. Hopefully it also works under Linux (read the
         Graph unit is platform independant enough) Compile with -dUseGraphics.
+v0.09 - Fixes for Win32 GUI mode.
 
 ----------
 SameGame.
@@ -219,6 +220,7 @@ v0.03  - Fix to game unit that upset configuration files under 0.99.13
        - Weirdly enough, mouse cursor disappears when moving over a black spot.
           Playing with delays was unsuccesfull.
        - Graphical support. Compile with -dUseGraphics
+v0.04 - Fixes for Win32 GUI mode.
 
 ----------
 Gravwars (author:Sohrab Ismail-Beigi)

+ 29 - 2
demo/graph/fpctris.pp

@@ -44,7 +44,20 @@ TheHeight-1
 
 }
 
-Uses Crt,Dos,
+{$ifdef UseGraphics}
+ {$ifdef Win32}
+   {$define Win32Graph}
+   {$APPTYPE GUI}
+ {$endif}
+{$endif}
+
+Uses
+{$ifdef Win32Graph}
+ WinCrt, Windows,
+{$else}
+ Crt,
+{$endif}
+ Dos,
 {$IFDEF UseGraphics}
  Graph,
 {$ENDIF}
@@ -577,6 +590,9 @@ VAR
 
 BEGIN
 {$IFDEF UseGraphics}
+  {$ifdef Win32}
+   ShowWindow(GetActiveWindow,0);
+  {$endif}
   gm:=vgahi;
   gd:=vga;
   InitGraph(gd,gm,'');
@@ -600,8 +616,10 @@ BEGIN
  {$ELSE}
   UseColor:=TRUE;
  {$ENDIF}
+ {$ifndef Win32Graph}
  ClrScr;
  CursorOff;
+ {$endif}
  RANDOMIZE;
  HighX:=BaseX;
  HighY:=BaseY;
@@ -695,7 +713,9 @@ BEGIN
 ORD('q'),
    ESC     : BEGIN
              SetDefaultColor;
+             {$ifndef Win32Graph}
              GotoXY(1,25);
+             {$endif}
              EndGame:=TRUE;
             END;
 
@@ -807,11 +827,15 @@ ORD('p') : BEGIN                             {"p" : Pause}
  DisplMainField;
  UNTIL EndGame;
  FixHighScores;
+ {$ifndef Win32Graph}
  CursorOn;
  SetDefaultColor;
  GotoXY(1,25);
+ {$endif}
  {$IFDEF UseGraphics}
+  {$ifndef Win32}
   TextMode(CO80);
+  {$endif}
  {$ENDIF}
 END;
 
@@ -829,7 +853,10 @@ END.
 
 {
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:08  michael

+ 6 - 1
demo/graph/ftrisgr.inc

@@ -146,8 +146,13 @@ BEGIN
    Bar(300,440,450,458);
    OutTextXY(300,440,'Score :'+S);
 END;
+
+{
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:08  michael

+ 6 - 1
demo/graph/ftristxt.inc

@@ -236,8 +236,13 @@ BEGIN
    GotoXY(40,18);
    Write('Score :',Score);
 END;
+
+{
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:08  michael

+ 91 - 40
demo/graph/gameunit.pp

@@ -44,6 +44,12 @@ INTERFACE
   {$define MouseAPI}
   {$G+}
 {$endif}
+{$ifdef UseGraphics}
+ {$ifdef Win32}
+   {$define Win32Graph}
+ {$endif}
+{$endif}
+
 CONST  LineDistY=13;
 
 
@@ -136,19 +142,28 @@ PROCEDURE outportl(portx : word;data : longint);
 
 IMPLEMENTATION
 
-{$IFDEF MouseAPI}
- {$IFDEF UseGraphics}
-  Uses Mouse,Dos,Crt,Graph;
- {$ELSE}
-  Uses Mouse,Dos,Crt;
- {$ENDIF}
-{$ELSE}
-  {$IFDEF UseGraphics}
-  Uses MsMouse,Dos,Crt,Graph;
+Uses
+
+{$ifdef Win32Graph}
+   WinMouse,
+   {$undef MouseApi}
+{$else}
+ {$IFDEF MouseAPI}
+   Mouse,
  {$ELSE}
-  Uses MsMouse,Dos,Crt;
+   MSMouse,
  {$ENDIF}
-{$ENDIF}
+{$endif}
+
+{$ifdef UseGraphics}
+  Graph,
+{$endif}
+{$ifdef Win32Graph}
+  WinCrt,
+{$else}
+  Crt,
+{$endif}
+  Dos;
 
 VAR  DefColor    : BYTE;                         {Backup of startup colors}
 
@@ -172,39 +187,54 @@ END;
 PROCEDURE ShowMouse;
 
 BEGIN
+ {$ifdef Win32Graph}
+  WinMouse.ShowMouse;
+ {$else}
   {$IFDEF MouseAPI}
-  Mouse.ShowMouse;
- {$ELSE}
-  MsMouse.ShowMouse;
- {$ENDIF}
+   Mouse.ShowMouse;
+  {$ELSE}
+   MsMouse.ShowMouse;
+  {$ENDIF}
+ {$endif}
 END;
 
 PROCEDURE HideMouse;
 
 BEGIN
- {$IFDEF MouseAPI}
-  Mouse.HideMouse;
- {$ELSE}
-  MsMouse.HideMouse;
- {$ENDIF}
+ {$ifdef Win32Graph}
+  WinMouse.HideMouse;
+ {$else}
+  {$IFDEF MouseAPI}
+   Mouse.HideMouse;
+  {$ELSE}
+   MsMouse.HideMouse;
+  {$ENDIF}
+ {$endif}
 END;
 
 PROCEDURE InitMouse;
 
 BEGIN
- {$IFDEF MouseAPI}
-  Mouse.InitMouse;
- {$ELSE}
-  MsMouse.InitMouse;
- {$ENDIF}
+ {$ifdef Win32Graph}
+  WinMouse.InitMouse;
+ {$else}
+  {$IFDEF MouseAPI}
+   Mouse.InitMouse;
+  {$ELSE}
+   MsMouse.InitMouse;
+  {$ENDIF}
+ {$endif}
 END;
 
 PROCEDURE DoneMouse;
 
 BEGIN
- {$IFDEF MouseAPI}
-  Mouse.DoneMouse;
- {$ENDIF}
+ {$ifdef Win32Graph}
+ {$else}
+  {$IFDEF MouseAPI}
+   Mouse.DoneMouse;
+  {$ENDIF}
+ {$endif}
 END;
 
 PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT);
@@ -220,17 +250,23 @@ BEGIN
    MY:=MouseEvent.Y SHL 3;
    MState:=MouseEvent.Buttons;
  {$ELSE}
-  MsMouse.GetMouseState(MX,MY,MState);
+  {$ifdef Win32Graph}
+   WinMouse.GetMouseState(MX,MY,MState);
+  {$else}
+   MsMouse.GetMouseState(MX,MY,MState);
+  {$endif}
  {$ENDIF}
 END;
 
 PROCEDURE SetMousePosition(X,Y:LONGINT);
 
 BEGIN
+ {$ifndef Win32Graph}
  {$IFDEF MouseAPI}
   SetMouseXY(x,y);
  {$ELSE}
   SetMousePos(X,Y);
+  {$endif}
  {$ENDIF}
 END;
 
@@ -409,7 +445,7 @@ END;
 PROCEDURE DoCursor; { Put Cursor in/out insert-mode }
 
 BEGIN
- {$IFNDEF Linux}
+ {$IFNDEF Unix}
 { IF Ins THEN
   SetCursorSize($11E)
  ELSE
@@ -454,16 +490,20 @@ BEGIN
       Posi:=Len;
      END;
     GotoXY(X+Posi-1,Y);
-    {$IFNDEF Linux}
+    {$IFNDEF Unix}
      {$IFDEF FPC}
-      CursorOn;
+       {$ifndef Win32Graph}
+        CursorOn;
+       {$endif}
      {$ENDIF}
     DoCursor;
     {$ENDIF}
     Key:=GetKey;
-   {$IFNDEF Linux}
+   {$IFNDEF Unix}
     {$IFDEF FPC}
-    CursorOff;
+     {$ifndef Win32Graph}
+      CursorOff;
+     {$endif}
     {$ENDIF}
    {$ENDIF}
     CASE Key OF
@@ -623,16 +663,20 @@ BEGIN
       Full:=TRUE;
       Posi:=Len;
      END;
-    {$IFNDEF Linux}
+    {$IFNDEF Unix}
      {$IFDEF FPC}
-      CursorOn;
+      {$ifndef Win32Graph}
+       CursorOn;
+      {$endif}
      {$ENDIF}
     DoCursor;
     {$ENDIF}
     Key:=GetKey;
    {$IFNDEF Linux}
     {$IFDEF FPC}
-    CursorOff;
+     {$ifndef Win32Graph}
+      CursorOff;
+     {$endif}
     {$ENDIF}
    {$ENDIF}
     CASE Key OF
@@ -703,8 +747,10 @@ END;
 PROCEDURE SetDefaultColor;
 
 BEGIN
- TextColor(DefColor AND 15);
- TextBackground(DefColor SHR 4);
+ {$ifndef UseGraphics}
+  TextColor(DefColor AND 15);
+  TextBackground(DefColor SHR 4);
+ {$endif}
 END;
 
 
@@ -853,12 +899,17 @@ END;
 {$ENDIF}
 
 BEGIN
+ {$ifndef Win32Graph}
   DefColor:=TextAttr;                { Save the current attributes, to restore}
+ {$endif}
   Negative:=FALSE;                    { Negative=true-> better scores are lower}
 END.
 {
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:08  michael

+ 20 - 2
demo/graph/gravwars.pp

@@ -21,7 +21,18 @@ ORIGINAL Header:
      Turbo Pascal 4.0 source code.  Requires VGA 640x480x16 display.
      Note: pix=pixels in the comments}
 
-Uses Crt,Graph;
+{$ifdef Win32}
+ {$apptype GUI}
+{$endif}
+
+Uses
+ {$ifdef Win32}
+  Windows,
+  WinCrt,
+ {$else}
+  Crt,
+ {$endif}
+ Graph;
 
 Type
     spacecraft=Record                       {used for ships and pointer}
@@ -58,6 +69,10 @@ begin
   //SetGraphBufSize(10);
   GraphDriver:=VGA;
   GraphMode:=VGAHi;
+  {$ifdef Win32}
+   ShowWindow(GetActiveWindow,0);
+  {$endif}
+
   InitGraph(GraphDriver,GraphMode,'');
   setbkcolor(black);
   setviewport(0,0,getmaxx,getmaxy,clipoff);
@@ -909,7 +924,10 @@ BEGIN
   Finish;
 END.
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:08  michael

+ 18 - 3
demo/graph/mandel.pp

@@ -21,7 +21,14 @@ program mandel;
   Note: For linux you need to run this program as root !!
 }
 
+{$ifdef Win32}
+ {$apptype GUI}
+{$endif}
+
 uses
+{$ifdef Win32}
+ Windows,
+{$endif}
   dos,Graph;
 
 {
@@ -288,6 +295,9 @@ begin
     GetModeRange(gd,dummy,gm);
   GetTime(hour, minute, second, sec100);
   starttime:=((hour*60+minute)*60+second)*100+sec100;
+  {$ifdef Win32}
+   ShowWindow(GetActiveWindow,0);
+  {$endif}
   InitGraph(gd,gm,'');
   if GraphResult <> grOk then
     begin
@@ -331,12 +341,17 @@ begin
   readln;
 {$endif fpc_profile}
   CloseGraph;
-  Writeln('Mandel took ',Real(neededtime)/100/count:0:3,' secs to generate mandel graph');
-  Writeln('With graph driver ',gd,' and graph mode ',gm);
+  {$ifndef Win32}
+   Writeln('Mandel took ',Real(neededtime)/100/count:0:3,' secs to generate mandel graph');
+   Writeln('With graph driver ',gd,' and graph mode ',gm);
+  {$endif}
 end.
 {
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.3  2001/04/25 22:45:41  peter

+ 30 - 7
demo/graph/maze.pp

@@ -27,8 +27,15 @@ Don't forget the BGIPATH of InitGraph.
 
 program makemaze;
 
+{$apptype GUI}
+
 uses
-  crt, graph;
+ {$ifdef Win32}
+  WinCrt,Windows,
+ {$else}
+  crt,
+ {$endif}
+  graph;
 
 const
   screenwidth   = 640;
@@ -425,7 +432,9 @@ procedure getsize;
 var
   j, k : real;
 begin
+ {$ifndef win32}
   clrscr;
+ {$endif}
   writeln('       Mind');
   writeln('       Over');
   writeln('       Maze');
@@ -446,9 +455,9 @@ begin
     maxrun := 65535;  { infinite }
   j := Real(screenwidth) / blockwidth;
   k := Real(screenheight) / blockwidth;
-  if j = int(j) then
+  if j = system.int(j) then
     j := j - 1;
-  if k = int(k) then
+  if k= system.int(k) then
     k := k - 1;
   width  := trunc(j);
   height := trunc(k);
@@ -461,23 +470,37 @@ begin
 end;
 
 begin
+ {$ifdef Win32}
+  ShowWindow(GetActiveWindow,0);
+  Initbgi;
+ {$endif}
   repeat
     getsize;
-    initbgi;
+    {$ifndef Win32}
+     initbgi;
+    {$endif}
     new(cell);    { allocate this large array on heap }
     drawmaze;
     solvemaze;
     dispose(cell);
-    closegraph;
+    {$ifndef Win32}
+     closegraph;
+    {$endif}
     while keypressed do
       ch := readkey;
     write ('another one? ');
     ch := upcase (readkey);
   until (ch = 'N') or (ch = #27);
+  {$ifdef Win32}
+   CloseGraph;
+  {$endif}
 end.
-
+{
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:49  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:08  michael

+ 61 - 15
demo/graph/samegame.pp

@@ -23,11 +23,30 @@
  **********************************************************************}
 PROGRAM SameGame;
 
-Uses Crt,Dos,
+
+{$ifdef UseGraphics}
+ {$ifdef Win32}
+   {$define Win32Graph}
+    {$apptype GUI}
+ {$endif}
+{$endif}
+
+
+Uses
+{$ifdef Win32}
+  Windows,
+{$endif}
+{$ifdef Win32Graph}
+  WinCrt,
+ {$else}
+  Crt,
+{$endif}
+  Dos,
 {$IFDEF UseGraphics}
- Graph,
+  Graph,
+  {$INFO GRAPH}
 {$ENDIF}
- GameUnit;
+  GameUnit;
 
 CONST
    {$IFDEF UseGraphics}
@@ -335,6 +354,8 @@ END;
 PROCEDURE BuildScreen;
 {Some procedures that build the screen}
 
+var s : String;
+
 BEGIN
   {$IFDEF UseGraphics}
    setbkcolor(black);
@@ -349,7 +370,6 @@ BEGIN
   ShowHighScore;
   ShowMouse;
   {$IFDEF UseGraphics}
-
    SetTextStyle(0,Horizdir,2);
    OuttextXY(10,10,'SameGame v0.03, (C) by Marco v/d Voort. ');
    SetTextStyle(0,Horizdir,1);
@@ -366,8 +386,14 @@ BEGIN
   {$ENDIF}
   IF LastScore<>0 THEN
    BEGIN
-    GotoXY(10,20);
-    Write('The score in the last game was :',LastScore);
+    {$Ifdef UseGraphics}
+     SetTextStyle(0,Horizdir,1);
+     Str(LastScore,S);
+     OuttextXY(50,40,'The Score in the last game was :'+S);
+    {$else}
+     GotoXY(10,20);
+     Write('The score in the last game was :',LastScore);
+    {$endif}
    END;
   DisplayPlayField(PlayField);
  MarkField:=PlayField;
@@ -451,11 +477,19 @@ BEGIN
           MarkField:=PlayField;
           MarkAfield(X,Y);
           DisplayPlayField(MarkField);
-          TextColor(White);
-          GotoXY(20,22);
-          Write(' ':20);
-          GotoXY(20,22);
-          Write('Marked :',CubesToScore);
+          {$ifdef UseGraphics}
+           SetFillStyle(SolidFill,black);
+           Bar(420,440,540,460);
+           SetTextStyle(0,Horizdir,1);
+           Str(CubesToScore,S);
+           OuttextXY(420,440,'Marked : '+S);
+          {$else}
+           TextColor(White);
+           GotoXY(20,22);
+           Write(' ':20);
+           GotoXY(20,22);
+           Write('Marked :',CubesToScore);
+          {$endif}
          END;
         IF (MarkField[X,Y]=4) AND ((MState AND LButton) <>0) THEN
                                    {If leftbutton pressed,}
@@ -508,6 +542,9 @@ VAR I : LONGINT;
 
 BEGIN
  {$IFDEF UseGraphics}
+  {$ifdef Win32}
+   ShowWindow(GetActiveWindow,0);
+  {$endif}
   gm:=vgahi;
   gd:=vga;
   InitGraph(gd,gm,'');
@@ -529,7 +566,9 @@ BEGIN
    HighScore[I].Score:=I*1500;
   LoadHighScore(FileName);
   InitMouse;
-  CursorOff;
+  {$ifndef Win32Graph}
+   CursorOff;
+  {$endif}
  {$IFDEF UseGraphics}
     HighX:=450;   HighY:=220; {the position of the highscore table}
  {$else}
@@ -540,18 +579,25 @@ BEGIN
 
   HideMouse;
   DoneMouse;
-  CursorOn;
+  {$ifndef Win32Graph}
+   CursorOn;
+  {$endif}
   SaveHighScore;
   {$IFDEF UseGraphics}
    CloseGraph;
   {$ENDIF}
-  ClrScr;
+  {$ifndef Win32Graph}
+   ClrScr;
   Writeln;
   Writeln('Last games'#39' score was : ',Score);
+  {$endif}
 END.
 {
   $Log$
-  Revision 1.1  2001-05-03 21:39:33  peter
+  Revision 1.2  2001-11-11 21:09:50  marco
+   * Gameunit, Fpctris and samegame  fixed for win32 GUI
+
+  Revision 1.1  2001/05/03 21:39:33  peter
     * moved to own module
 
   Revision 1.2  2000/07/13 11:33:09  michael