home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 February / PCWorld_2003-02_cd.bin / Software / Topware / devpascal / examples / Tetris / gameunit.pp < prev    next >
Text File  |  2000-09-13  |  21KB  |  895 lines
  1. {
  2.     $Id: gameunit.pp,v 1.1 2000/03/09 02:40:03 alex Exp $
  3.  
  4.     A simple unit with some common used routines for FPCGames (FpcTris and
  5.       SameGame)
  6.  
  7.     Contains
  8.      - Highscore routines "developped" for FPCTris, but now also used by SameGame
  9.      - "Dummy" mouse routines which either shell to API units or to MSMouse.
  10.  
  11.     See the file COPYING.FPC, included in this distribution,
  12.     for details about the copyright.
  13.  
  14.     This program is distributed in the hope that it will be useful,
  15.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  17.  
  18.  **********************************************************************}
  19. UNIT GameUnit;
  20.  
  21. INTERFACE
  22. {$LONGSTRINGS OFF}
  23.  
  24. {MouseAPI defined : unit unes API mouse units, which requires that package,
  25.                     but also works under Linux
  26.  MouseAPI undef   : RTL unit MsMouse. API not required, but doesn't work under
  27.                     Linux }
  28.  
  29.  
  30. {$ifdef linux}
  31.   {$define MouseAPI}
  32. {$endif}
  33. {$ifdef win32}
  34.   {$define MouseAPI}
  35. {$endif}
  36. {$IFDEF Ver70}
  37.   {$define MouseAPI}
  38.   {$G+}
  39. {$endif}
  40. {$IFDEF Ver60}
  41.   {$define MouseAPI}
  42.   {$G+}
  43. {$endif}
  44. {$IFDEF Ver55}
  45.   {$define MouseAPI}
  46.   {$G+}
  47. {$endif}
  48. CONST  LineDistY=13;
  49.  
  50.  
  51. TYPE CHARSET=SET OF CHAR;
  52.  
  53. {----   Unified Mouse procedures. ---- }
  54.  
  55. FUNCTION MousePresent : BOOLEAN;
  56.  
  57. PROCEDURE HideMouse;
  58. PROCEDURE ShowMouse;
  59. PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT);
  60. PROCEDURE DoneMouse;
  61. PROCEDURE InitMouse;
  62. PROCEDURE SetMousePosition(X,Y:LONGINT);
  63.  
  64.  
  65. Const LButton = 1; {left button}
  66.       RButton = 2; {right button}
  67.       MButton = 4; {middle button}
  68.  
  69.  
  70. {---- Standard Highscore procedures ----}
  71.  
  72. TYPE  HighScoreType   = Packed RECORD
  73.                         Name : String[15];
  74.                         Score: LONGINT;
  75.                        END;
  76.      HighScoreArr    = ARRAY[0..9] OF HighScoreType;
  77.  
  78. VAR HighScore   : HighScoreArr;
  79.     ScorePath   : String;
  80.     HighX,HighY : LONGINT;
  81.     Negative    : BOOLEAN;      { Negative=true-> better scores are lower}
  82.  
  83. PROCEDURE LoadHighScore(FileName:STRING);
  84. PROCEDURE SaveHighScore;
  85. PROCEDURE ShowHighScore;
  86.  
  87. FUNCTION  SlipInScore(Score:LONGINT):LONGINT;
  88.  
  89. {---- Keyboard routines ----}
  90.  
  91. CONST {Constants for GetKey}
  92.    ArrU   = $04800;    ArrL   = $04B00;    ArrR   = $04D00;   BS  = $08;  (* Backspace *)
  93.    ArrD   = $05000;    CR     = $0D;       ESC    = $1B;      KDelete= $05300;
  94.    KInsert= $05200;    Home   = $04700;    KEnd   = $04F00;   CtrlY = $19;
  95.    CtrlT = $14;
  96.  
  97. CONST FieldSpace : CHAR = #177;
  98.       AlfaBeta : CHARSET= [' '..'z'];
  99.  
  100. FUNCTION GetKey:LONGINT;
  101.  
  102. {Generic string input routine}
  103. {$IFDEF UseGraphics}
  104. FUNCTION  GrInputStr(VAR S:String;X,Y,Len,dX,dY:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
  105. {$ELSE}
  106. FUNCTION  InputStr(VAR S:String;X,Y,Len:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
  107. {$ENDIF}
  108.  
  109. {---- Misc ----}
  110.  
  111. PROCEDURE SetDefaultColor; {Restore the attribs saved on startup}
  112.  
  113. {BP compability}
  114.  
  115. {$IFNDEF FPC}
  116. PROCEDURE SetCursorSize(CurDat:WORD);
  117. FUNCTION  GetCursorSize:WORD;
  118. PROCEDURE CursorOn;
  119. PROCEDURE CursorOff;
  120.  
  121. {Non Go32 but not existant in BP}
  122. PROCEDURE FillWord(VAR Data;Count,Value:WORD);
  123.  
  124. PROCEDURE dosmemfillword(Segx,xofs,Count,Value:WORD);
  125. PROCEDURE dosmemput(Segx,xofs:WORD;VAR Data;Count:WORD);
  126. PROCEDURE dosmemget(Segx,xofs:WORD;VAR Data;Count:WORD);
  127.  
  128. FUNCTION  inportb(portx : word) : byte;
  129. PROCEDURE outportb(portx : word;data : byte);
  130.  
  131. FUNCTION  inportw(portx : word) : word;
  132. PROCEDURE outportw(portx : word;data : word);
  133.  
  134. FUNCTION  inportl(portx : word) : longint;
  135. PROCEDURE outportl(portx : word;data : longint);
  136. {$ENDIF}
  137.  
  138. IMPLEMENTATION
  139.  
  140. {$IFDEF MouseAPI}
  141.  {$IFDEF UseGraphics}
  142.   Uses Mouse,Dos,Crt,Graph;
  143.  {$ELSE}
  144.   Uses Mouse,Dos,Crt;
  145.  {$ENDIF}
  146. {$ELSE}
  147.   {$IFDEF UseGraphics}
  148.   Uses MsMouse,Dos,Crt,Graph;
  149.  {$ELSE}
  150.   Uses MsMouse,Dos,Crt;
  151.  {$ENDIF}
  152. {$ENDIF}
  153.  
  154. VAR  DefColor    : BYTE;                         {Backup of startup colors}
  155.  
  156. CONST
  157.  
  158. {The initial names. If people feel they are missing, I first checked the Alias,
  159.   and then filled with names of the FPC-Devel list, and arranged them alfabetically}
  160.   InitNames : ARRAY[0..9] OF String[12] = ('Carl','Daniel','Florian','Jonas','John','Marco','Michael (3x)',
  161.                                            'Peter','Pierre','Thomas' );
  162.  
  163. FUNCTION MousePresent : BOOLEAN;
  164.  
  165. BEGIN
  166.  {$IFDEF MouseAPI}
  167.   MousePresent:=DetectMouse<>0;
  168.  {$ELSE}
  169.   MousePresent:=MouseFound;
  170.  {$ENDIF}
  171. END;
  172.  
  173. PROCEDURE ShowMouse;
  174.  
  175. BEGIN
  176.   {$IFDEF MouseAPI}
  177.   Mouse.ShowMouse;
  178.  {$ELSE}
  179.   MsMouse.ShowMouse;
  180.  {$ENDIF}
  181. END;
  182.  
  183. PROCEDURE HideMouse;
  184.  
  185. BEGIN
  186.  {$IFDEF MouseAPI}
  187.   Mouse.HideMouse;
  188.  {$ELSE}
  189.   MsMouse.HideMouse;
  190.  {$ENDIF}
  191. END;
  192.  
  193. PROCEDURE InitMouse;
  194.  
  195. BEGIN
  196.  {$IFDEF MouseAPI}
  197.   Mouse.InitMouse;
  198.  {$ELSE}
  199.   MsMouse.InitMouse;
  200.  {$ENDIF}
  201. END;
  202.  
  203. PROCEDURE DoneMouse;
  204.  
  205. BEGIN
  206.  {$IFDEF MouseAPI}
  207.   Mouse.DoneMouse;
  208.  {$ENDIF}
  209. END;
  210.  
  211. PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT);
  212.  
  213.   {$IFDEF MouseAPI}
  214.    VAR MouseEvent : TMouseEvent;
  215.   {$ENDIF}
  216.  
  217. BEGIN
  218.   {$IFDEF MouseAPI}
  219.    GetMouseEvent(MouseEvent);
  220.    MX:=MouseEvent.X SHL 3;
  221.    MY:=MouseEvent.Y SHL 3;
  222.    MState:=MouseEvent.Buttons;
  223.  {$ELSE}
  224.   MsMouse.GetMouseState(MX,MY,MState);
  225.  {$ENDIF}
  226. END;
  227.  
  228. PROCEDURE SetMousePosition(X,Y:LONGINT);
  229.  
  230. BEGIN
  231.  {$IFDEF MouseAPI}
  232.   SetMouseXY(x,y);
  233.  {$ELSE}
  234.   SetMousePos(X,Y);
  235.  {$ENDIF}
  236. END;
  237.  
  238. Procedure LoadHighScore(FileName:STRING);
  239.  
  240. var
  241.  F: File;
  242.  I : LONGINT;
  243.  OFileMode : LONGINT;
  244.  
  245. BEGIN
  246.  {$I-}
  247.  Assign(F, FileName);
  248.  OFileMode:=FileMode;
  249.  FileMode := 0;  {Set file access to read only }
  250.  Reset(F);
  251.  Close(F);
  252.  {$I+}
  253.  IF IOResult=0 THEN
  254.   ScorePath:=FileName
  255.  ELSE
  256.   ScorePath:=FSearch(FileName,GetEnv('PATH'));
  257.  IF ScorePath='' THEN
  258.   BEGIN
  259.    FOR I:=0 TO 9 DO
  260.     BEGIN
  261.      HighScore[I].Name:=InitNames[I];
  262.      HighScore[I].Score:=(I+1)*750;
  263.     END;
  264.    ScorePath:=FileName;
  265.   END
  266.  ELSE
  267.   BEGIN
  268.    Assign(F,ScorePath);
  269.    Reset(F,1);
  270.    BlockRead(F,HighScore,SIZEOF(HighScoreArr));
  271.    Close(F);
  272.   END;
  273.  FileMode:=OFileMode;
  274. END;
  275.  
  276. Procedure SaveHighScore;
  277.  
  278. var
  279.  F: File;
  280.  
  281. BEGIN
  282.  Assign(F,ScorePath);
  283.  Rewrite(F,1);
  284.  BlockWrite(F,HighScore,SIZEOF(HighScoreArr));
  285.  Close(F);
  286. END;
  287.  
  288. FUNCTION  SlipInScore(Score:LONGINT):LONGINT;
  289.  
  290. VAR I,J : LONGINT;
  291.  
  292. BEGIN
  293.  IF Negative THEN
  294.   Score:=-Score;
  295.  I:=0;
  296.  WHILE (Score>HighScore[I].Score) AND (I<10) DO
  297.   INC(I);
  298.  IF I<>0 THEN
  299.   BEGIN
  300.    IF I>1 THEN
  301.     FOR J:=0 TO I-2 DO
  302.      HighScore[J]:=HighScore[J+1];
  303.     HighScore[I-1].Score:=Score;
  304.     HighScore[I-1].Name:='';
  305.   END;
  306.  SlipInScore:=I;
  307. END;
  308.  
  309. {$IFDEF UseGraphics}
  310.  
  311. PROCEDURE ShowHighScore;
  312.  
  313. VAR I : LONGINT;
  314.     S : String;
  315.  
  316. BEGIN
  317.  SetFillStyle(SolidFill,0);            {Clear part of playfield}
  318.  Bar(HighX,HighY, 638, HighY+20+18*LineDistY);
  319.  FOR I:=0 TO 9 DO
  320.   BEGIN
  321.    OutTextXY(HighX,HighY+(9-I)*LineDistY,HighScore[I].Name);
  322.    IF Negative THEN
  323.     Str(-HighScore[I].Score:5,S)
  324.    ELSE
  325.     Str(HighScore[I].Score:5,S);
  326.    OutTextXY(HighX+150,HighY+(9-I)*LineDistY,S);
  327.   END;
  328. END;
  329.  
  330. {$ELSE}
  331. PROCEDURE ShowHighScore;
  332.  
  333. VAR I : LONGINT;
  334.  
  335. {HighX=40 HighY=9}
  336.  
  337. BEGIN
  338.  GotoXY(HighX+5,9); Write('The Highscores');
  339.  FOR I:=0 TO 9 DO
  340.   BEGIN
  341.    GotoXY(HighX,HighY+11-I);
  342.    Write(HighScore[I].Name,' ':(13-Length(HighScore[I].Name)),' ');
  343.    IF NOT Negative THEN     { Negative=true-> better scores are lower}
  344.     Write(HighScore[I].Score:5)
  345.    ELSE
  346.     Write(-HighScore[I].Score:5)
  347.   END;
  348. END;
  349. {$ENDIF}
  350.  
  351. FUNCTION GetKey:LONGINT;
  352.  
  353. VAR InKey: LONGINT;
  354.  
  355. BEGIN
  356.  InKey:=ORD(ReadKey);
  357.  IF InKey=0 THEN InKey:=ORD(ReadKey) SHL 8;
  358.  GetKey:=InKey;
  359. END;
  360.  
  361. {$IFNDEF UseGraphics}
  362. FUNCTION  InputStr(VAR S:String;X,Y,Len:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
  363. {
  364.   Input a string from keyboard, in a nice way,
  365.    allowed characters are in CHARSET CharAllow, but several editting
  366.    keys are always allowed, see CASE loop.
  367.  
  368. Parameters:
  369.  
  370.    X,Y       Coordinates field
  371.    Len       Length field
  372.    TextIn    S already filled?}
  373.  
  374. VAR
  375.     InGev                     : LONGINT; { No. of chars inputted }
  376.     Posi                      : LONGINT; { Cursorposition}
  377.     Ins                       : BOOLEAN;  { Insert yes/no}
  378.     Key                       : LONGINT; { Last key as ELib.GetKey
  379.                                             code <255 if normal key,
  380.                                             >256 if special/function
  381.                                             key. See keys.inc}
  382.     Uitg                      : String;    {The inputted string}
  383.     Full                      : BOOLEAN;   { Is the string full? }
  384.     EndVal                    : WORD;
  385.  
  386. PROCEDURE ReWr; { Rewrite the field, using Uitg}
  387.  
  388. VAR    I                         : LONGINT;  { Temporary variabele }
  389.  
  390. BEGIN
  391.  IF Length(Uitg)>Len THEN
  392.   Uitg[0]:=CHR(Len);
  393.  IF Length(Uitg)>0 THEN
  394.   FOR I:= 1 TO Length(Uitg) DO
  395.    BEGIN
  396.     GotoXY(X+I-1,Y);
  397.     IF Uitg[I]=CHR(32) THEN
  398.      Write(FieldSpace)
  399.     ELSE
  400.      Write(Uitg[I]);
  401.    END;
  402.  IF Len<>Length(Uitg) THEN
  403.   BEGIN
  404.    GotoXY(X+Length(Uitg),Y);
  405.    FOR I:= Length(Uitg) TO Len-1 DO
  406.     Write(FieldSpace);
  407.   END;
  408. END;
  409.  
  410. PROCEDURE DoCursor; { Put Cursor in/out insert-mode }
  411.  
  412. BEGIN
  413.  {$IFNDEF Linux}
  414. { IF Ins THEN
  415.   SetCursorSize($11E)
  416.  ELSE
  417.   SetCursorSize($71E); }
  418.  {$ENDIF}
  419.  
  420. END;
  421.  
  422. BEGIN
  423.     { Init }
  424.  
  425.   InGev :=0;              { 0 chars untill now }
  426.   Posi  :=1;               { Cursorposition 0 }
  427.   Ins   :=TRUE;            { Insert according to parameters }
  428.   DoCursor;        { Set cursor accordingly }
  429.   Key   :=0;
  430.  
  431.        { put ▒▒▒ padded field on screen }
  432.  
  433.   FillChar(Uitg,Len+1,FieldSpace);
  434.   Uitg[0]:=CHR(Len);
  435.   ReWr;
  436.   GotoXY(X,Y);
  437.  
  438.   FillChar(Uitg,Len,32);
  439.   UitG[0]:=#0;
  440.  
  441.   IF TextIn THEN
  442.    BEGIN
  443.     Uitg:=S;
  444.     Posi:=Length(Uitg)+1;                        { Put a predefined }
  445.     ReWr;                                   {  String on screen if specified }
  446.    END;
  447.  
  448.   EndVal:=0;
  449.   WHILE EndVal=0 DO
  450.    BEGIN
  451.     Full:=FALSE;
  452.     IF ((Posi)>=Len) THEN
  453.      BEGIN
  454.       Full:=TRUE;
  455.       Posi:=Len;
  456.      END;
  457.     GotoXY(X+Posi-1,Y);
  458.     {$IFNDEF Linux}
  459.      {$IFDEF FPC}
  460.       CursorOn;
  461.      {$ENDIF}
  462.     DoCursor;
  463.     {$ENDIF}
  464.     Key:=GetKey;
  465.    {$IFNDEF Linux}
  466.     {$IFDEF FPC}
  467.     CursorOff;
  468.     {$ENDIF}
  469.    {$ENDIF}
  470.     CASE Key OF
  471.           CR              : BEGIN
  472.                              EndVal:=1;
  473.                              S:=UitG;
  474.                             END;
  475.           ESC             : EndVal:=2;
  476.           BS              : IF Posi>1 THEN       { BackSpace }
  477.                               BEGIN
  478.                                DEC(Posi);
  479.                                Delete(Uitg,Posi,1);
  480.                                DEC(InGev);
  481.                                ReWr;
  482.                               END;
  483.           KDelete          : BEGIN
  484.                               Delete(Uitg,Posi,1);
  485.                               DEC(InGev);
  486.                               ReWr;
  487.                              END;
  488.           ArrR            : IF (NOT Full) AND ((Posi-1)<InGev) THEN
  489.                               BEGIN
  490.                                INC (Posi);
  491.                                GotoXY(X+Posi-1,Y);
  492.                                END;
  493.           KInsert          : BEGIN
  494.                                Ins:= NOT Ins;
  495.                                DoCursor;
  496.                               END;
  497.           ArrL            : IF (NOT (Posi=1)) THEN
  498.                               BEGIN
  499.                                DEC (Posi);
  500.                                GotoXY(X+Posi-1,Y);
  501.                               END;
  502.           Home            : Posi:=1;
  503.           KEnd            : Posi:=InGev-1;
  504.           CtrlY           : BEGIN
  505.                              Delete(Uitg,Posi,Length(Uitg)-Posi);
  506.                              ReWr;
  507.                             END;
  508.           CtrlT           : BEGIN
  509.                              Uitg[0]:=#0; Posi:=1; ReWr;
  510.                             END;
  511.     END; {Case}
  512.    IF EndVal=0 THEN
  513.     BEGIN
  514.      IF (CHR(Key) IN CharAllow) THEN
  515.       BEGIN
  516.        IF Posi>Len THEN
  517.         Posi:=Len;
  518.        IF (Ins=FALSE) OR Full THEN
  519.         BEGIN
  520.          IF (ORD(Uitg[0])<Posi) THEN
  521.            Uitg[0]:=CHR(Posi);
  522.          Uitg[Posi]:=CHR(Key);
  523.         END
  524.        ELSE
  525.         BEGIN
  526.          Insert(CHR(Key),Uitg,Posi);
  527.         END;
  528.        ReWr;
  529.        INC(Posi);
  530.       END;
  531.      END;
  532.     InGev:=Length(Uitg);
  533.    END;
  534.   InputStr:=Endval=1;
  535. END;
  536. {$ENDIF}
  537.  
  538. {$IFDEF UseGraphics}
  539. FUNCTION  GrInputStr(VAR S:String;X,Y,Len,dX,dY:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN;
  540. {As the (older) textversion except:
  541.     -  oX,oY are in pixels.
  542.     -  dX,dY are the dimensions of the font.
  543.     -  Len is still characters ( length in pixels/dX)
  544. }
  545.  
  546.  
  547. VAR
  548.     InGev                     : LONGINT; { No. of chars inputted }
  549.     Posi                      : LONGINT; { Cursorposition}
  550.     Ins                       : BOOLEAN;  { Insert yes/no}
  551.     Key                       : LONGINT; { Last key as ELib.GetKey
  552.                                             code <255 if normal key,
  553.                                             >256 if special/function
  554.                                             key. See keys.inc}
  555.     Uitg                      : String;    {The inputted string}
  556.     Full                      : BOOLEAN;   { Is the string full? }
  557.     EndVal                    : WORD;
  558.  
  559. PROCEDURE ReWr; { Rewrite the field, using Uitg}
  560.  
  561. VAR    I                         : LONGINT;  { Temporary variabele }
  562.        S                         : String;
  563.  
  564. BEGIN
  565.  FillChar(S[1],Len,FieldSpace);
  566.  S:=Uitg;
  567.  IF Length(Uitg)>Len THEN
  568.   SetLength(Uitg,Len);
  569.  SetLength(S,Len);
  570.  IF Length(S)>0 THEN
  571.   BEGIN
  572.    FOR I:= 1 TO Length(S) DO
  573.     IF S[I]=CHR(32) THEN
  574.      S[I]:=FieldSpace;
  575.    SetFillStyle(SolidFill,0);
  576.    Bar(X,Y,X+Len*Dx+5,Y+Dy+1);
  577.    OutTextXY(X,Y,S);
  578.   END;
  579. END;
  580.  
  581. PROCEDURE DoCursor; { Put Cursor in/out insert-mode }
  582.  
  583. BEGIN
  584.  {$IFNDEF Linux}
  585. { IF Ins THEN
  586.   SetCursorSize($11E)
  587.  ELSE
  588.   SetCursorSize($71E); }
  589.  {$ENDIF}
  590. END;
  591.  
  592. BEGIN
  593.     { Init }
  594.  
  595.   InGev :=0;              { 0 chars untill now }
  596.   Posi  :=1;               { Cursorposition 0 }
  597.   Ins   :=TRUE;            { Insert according to parameters }
  598.   DoCursor;        { Set cursor accordingly }
  599.   Key   :=0;
  600. //  SetFillStyle(SolidFill,0);
  601. //  Bar(X,Y,X+Len*Dx+5,Y+Dy+1);
  602.        { put ▒▒▒ padded field on screen }
  603.  
  604.   FillChar(Uitg,Len+1,FieldSpace);
  605.   Uitg[0]:=CHR(Len);
  606.   ReWr;
  607. //  GotoXY(X,Y);
  608.   FillChar(Uitg,Len,32);
  609.   SetLength(UitG,0);
  610.  
  611.   IF TextIn THEN
  612.    BEGIN
  613.     Uitg:=S;
  614.     Posi:=Length(Uitg)+1;                        { Put a predefined }
  615.     ReWr;                                   {  String on screen if specified }
  616.    END;
  617.  
  618.   EndVal:=0;
  619.   WHILE EndVal=0 DO
  620.    BEGIN
  621.     Full:=FALSE;
  622.     IF ((Posi)>=Len) THEN
  623.      BEGIN
  624.       Full:=TRUE;
  625.       Posi:=Len;
  626.      END;
  627.     {$IFNDEF Linux}
  628.      {$IFDEF FPC}
  629.       CursorOn;
  630.      {$ENDIF}
  631.     DoCursor;
  632.     {$ENDIF}
  633.     Key:=GetKey;
  634.    {$IFNDEF Linux}
  635.     {$IFDEF FPC}
  636.     CursorOff;
  637.     {$ENDIF}
  638.    {$ENDIF}
  639.     CASE Key OF
  640.           CR              : BEGIN
  641.                              EndVal:=1;
  642.                              S:=UitG;
  643.                             END;
  644.           ESC             : EndVal:=2;
  645.           BS              : IF Posi>1 THEN       { BackSpace }
  646.                               BEGIN
  647.                                DEC(Posi);
  648.                                Delete(Uitg,Posi,1);
  649.                                DEC(InGev);
  650.                                ReWr;
  651.                               END;
  652.           KDelete          : BEGIN
  653.                               Delete(Uitg,Posi,1);
  654.                               DEC(InGev);
  655.                               ReWr;
  656.                              END;
  657.           ArrR            : IF (NOT Full) AND ((Posi-1)<InGev) THEN
  658.                               BEGIN
  659.                                INC (Posi);
  660.   //                             GotoXY(X+Posi-1,Y);
  661.                                END;
  662.           KInsert          : BEGIN
  663.                                Ins:= NOT Ins;
  664.                                DoCursor;
  665.                               END;
  666.           ArrL            : IF (NOT (Posi=1)) THEN
  667.                               BEGIN
  668.                                DEC (Posi);
  669.                               END;
  670.           Home            : Posi:=1;
  671.           KEnd            : Posi:=InGev-1;
  672.           CtrlY           : BEGIN
  673.                              Delete(Uitg,Posi,Length(Uitg)-Posi);
  674.                              ReWr;
  675.                             END;
  676.           CtrlT           : BEGIN
  677.                              Uitg[0]:=#0; Posi:=1; ReWr;
  678.                             END;
  679.     END; {Case}
  680.    IF EndVal=0 THEN
  681.     BEGIN
  682.      IF (CHR(Key) IN CharAllow) THEN
  683.       BEGIN
  684.        IF Posi>Len THEN
  685.         Posi:=Len;
  686.        IF (Ins=FALSE) OR Full THEN
  687.         BEGIN
  688.          IF (Length(Uitg)<Posi) THEN
  689.           SetLength(UitG,Posi);
  690.          Uitg[Posi]:=CHR(Key);
  691.         END
  692.        ELSE
  693.          Insert(CHR(Key),Uitg,Posi);
  694.        ReWr;
  695.        INC(Posi);
  696.       END;
  697.      END;
  698.     InGev:=Length(Uitg);
  699.    END;
  700.   GrInputStr:=Endval=1;
  701. END;
  702. {$ENDIF}
  703.  
  704. PROCEDURE SetDefaultColor;
  705.  
  706. BEGIN
  707.  TextColor(DefColor AND 15);
  708.  TextBackground(DefColor SHR 4);
  709. END;
  710.  
  711.  
  712. {$IFNDEF FPC}
  713. PROCEDURE SetCursorSize(CurDat:WORD);ASSEMBLER;
  714. ASM
  715.   mov ah,1
  716.   mov cx,CurDat
  717.   int $10
  718. END;
  719.  
  720. {The two procedures below are standard (and os-independant) in FPC's Crt}
  721. PROCEDURE CursorOn;
  722. BEGIN
  723.   SetCursorSize($090A);
  724. END;
  725.  
  726. PROCEDURE CursorOff;
  727. BEGIN
  728.   SetCursorSize($FFFF);
  729. END;
  730.  
  731. PROCEDURE dosmemfillword(Segx,xofs,Count,Value:WORD); ASSEMBLER;
  732. {VAR A:WORD;
  733. BEGIN
  734.   FOR A :=0 TO Count-1 DO
  735.     MemW[Seg:xofs+2*A]:=Value;
  736. END;
  737. }
  738. ASM
  739.   mov  ax,segx
  740.   mov  es,ax
  741.   mov  di,xofs
  742.   mov  cx,count
  743.   mov  ax,value
  744.   rep
  745.     stosw
  746. end;
  747.  
  748. {TYPE VetteArray=ARRAY[0..9999] OF BYTE;}
  749.  
  750. PROCEDURE dosmemput(Segx,xofs:WORD;VAR Data;Count:WORD); assembler;
  751. {VAR A:WORD;
  752.     L:^VetteArray;
  753. BEGIN
  754.   L:=@Data;
  755.   FOR A :=0 TO Count-1 DO
  756.     Mem[Segx:xofs+A]:=L^[A];
  757. END;
  758. }
  759. asm
  760.   lds si,Data
  761.   mov ax,segx
  762.   mov es,ax
  763.   mov di,xofs
  764.   mov cx,count
  765.   rep
  766.     movsw
  767. end;
  768.  
  769. PROCEDURE dosmemget(Segx,xofs:WORD;VAR Data;Count:WORD); ASSEMBLER;
  770. {VAR A:WORD;
  771.     L:^VetteArray;
  772. BEGIN
  773.   L:=@Data;
  774.   FOR A :=0 TO Count-1 DO
  775.     L^[A]:=Mem[Segx:xofs+A];
  776. END;
  777. }
  778. asm
  779.   les di,Data
  780.   mov ax,segx
  781.   mov ds,ax
  782.   mov si,xofs
  783.   mov cx,count
  784.   rep
  785.     movsw
  786. end;
  787.  
  788. PROCEDURE FillWord(VAR Data;Count,Value:WORD); ASSEMBLER;
  789. {VAR A :WORD;
  790.     L:^VetteArray;
  791. BEGIN
  792.   L:=@Data;
  793.   FOR A:=0 TO Count-1 DO
  794.   Begin
  795.     L^[2*A]:=Value AND 255;
  796.     L^[2*A+1]:=Value shr 8;
  797.   END;
  798. END;}
  799.  
  800. asm
  801.   les di,Data
  802.   mov cx,count
  803.   mov ax,Value
  804.   rep
  805.     movsw
  806. end;
  807.  
  808. FUNCTION GetCursorSize:WORD;ASSEMBLER;
  809. ASM
  810.   mov ah,3
  811.   xor bh,bh
  812.   int $10
  813.   mov ax,cx
  814. END;
  815.  
  816. FUNCTION  inportb(portx : word) : byte;
  817. BEGIN
  818.   Inportb:=Port[PortX];
  819. END;
  820.  
  821. PROCEDURE outportb(portx : word;data : byte);
  822. BEGIN
  823.   Port[portx]:=Data;
  824. END;
  825.  
  826. FUNCTION  inportw(portx : word) : word;
  827. BEGIN
  828.   Inportw:=Portw[PortX];
  829. END;
  830.  
  831. PROCEDURE outportw(portx : word;data : word);
  832. BEGIN
  833.   PortW[portx]:=Data;
  834. END;
  835.  
  836.  FUNCTION  inportl(portx : word) : longint; ASSEMBLER;
  837.  ASM
  838.    mov dx,portx                   { load port address }
  839.    db $66; in  ax,dx              { in  eax,dx }
  840.    db $66; mov dx,ax              { mov edx, eax }
  841.    db $66; shr dx,16              { shr edx, 16 }
  842.    { return: ax=low word, dx=hi word }
  843.  END;
  844.  
  845.  PROCEDURE  outportl(portx : word;data : longint); ASSEMBLER;
  846.  ASM
  847.    { we cant use the 32 bit operand prefix for loading the longint -
  848.      therefore we have to do that in two chunks }
  849.      mov dx, portx
  850.      db $66; mov ax, Word(Data)  { mov eax, Data }
  851.    db $66; out dx,ax              { out dx, eax }
  852.  END;
  853.  
  854. {$ENDIF}
  855.  
  856. BEGIN
  857.   DefColor:=TextAttr;                { Save the current attributes, to restore}
  858.   Negative:=FALSE;                    { Negative=true-> better scores are lower}
  859. END.
  860. {
  861.   $Log: gameunit.pp,v $
  862.   Revision 1.1  2000/03/09 02:40:03  alex
  863.   moved files
  864.  
  865.   Revision 1.6  2000/01/21 00:44:51  peter
  866.     * remove unused vars
  867.     * renamed to .pp
  868.  
  869.   Revision 1.5  2000/01/14 22:03:43  marco
  870.    * Change Lee's first name to John :-)
  871.  
  872.   Revision 1.4  2000/01/01 14:54:16  marco
  873.    * Added bp comtibility
  874.   :wq
  875.    * bp compat routines
  876.  
  877.  
  878.  
  879.  
  880.   B
  881.   B
  882.   B
  883.  
  884.   Revision 1.3  1999/12/31 17:05:25  marco
  885.  
  886.  
  887.   Graphical version and fixes. BP cursorroutines moved from FPCTRIS
  888.  
  889.   Revision 1.2  1999/06/11 12:51:29  peter
  890.     * updated for linux
  891.  
  892.   Revision 1.1  1999/06/01 19:24:33  peter
  893.     * updates from marco
  894. }
  895.