{ $Id$ A simple unit with some common used routines for FPCGames (FpcTris and SameGame) Contains - Highscore routines "developped" for FPCTris, but now also used by SameGame - "Dummy" mouse routines which either shell to API units or to MSMouse. 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 GameUnit; INTERFACE {MouseAPI defined : unit unes API mouse units, which requires that package, but also works under Linux MouseAPI undef : RTL unit MsMouse. API not required, but doesn't work under Linux } {$ifdef Unix} {$define MouseAPI} {$endif} {$ifdef win32} {$define MouseAPI} {$define UseGraphics} {Mandatory} {$endif} {$IFDEF Ver70} {$define MouseAPI} {$G+} {$endif} {$IFDEF Ver60} {$define MouseAPI} {$G+} {$endif} {$IFDEF Ver55} {$define MouseAPI} {$G+} {$endif} {$ifdef UseGraphics} {$ifdef Win32} {$define Win32Graph} {$endif} {$endif} CONST LineDistY=13; TYPE CHARSET=SET OF CHAR; {---- Unified Mouse procedures. ---- } FUNCTION MousePresent : BOOLEAN; PROCEDURE HideMouse; PROCEDURE ShowMouse; PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT); PROCEDURE DoneMouse; PROCEDURE InitMouse; PROCEDURE SetMousePosition(X,Y:LONGINT); Const LButton = 1; {left button} RButton = 2; {right button} MButton = 4; {middle button} {---- Standard Highscore procedures ----} TYPE HighScoreType = Packed RECORD Name : String[15]; Score: LONGINT; END; HighScoreArr = ARRAY[0..9] OF HighScoreType; VAR HighScore : HighScoreArr; ScorePath : String; HighX,HighY : LONGINT; Negative : BOOLEAN; { Negative=true-> better scores are lower} PROCEDURE LoadHighScore(FileName:STRING); PROCEDURE SaveHighScore; PROCEDURE ShowHighScore; FUNCTION SlipInScore(Score:LONGINT):LONGINT; {---- Keyboard routines ----} CONST {Constants for GetKey} ArrU = $04800; ArrL = $04B00; ArrR = $04D00; BS = $08; (* Backspace *) ArrD = $05000; CR = $0D; ESC = $1B; KDelete= $05300; KInsert= $05200; Home = $04700; KEnd = $04F00; CtrlY = $19; CtrlT = $14; CONST FieldSpace : CHAR = #177; AlfaBeta : CHARSET= [' '..'z']; FUNCTION GetKey:LONGINT; {Generic string input routine} {$IFDEF UseGraphics} FUNCTION GrInputStr(VAR S:String;X,Y,Len,dX,dY:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN; {$ELSE} FUNCTION InputStr(VAR S:String;X,Y,Len:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN; {$ENDIF} {---- Misc ----} PROCEDURE SetDefaultColor; {Restore the attribs saved on startup} {BP compability} {$IFNDEF FPC} PROCEDURE SetCursorSize(CurDat:WORD); FUNCTION GetCursorSize:WORD; PROCEDURE CursorOn; PROCEDURE CursorOff; {Non Go32 but not existant in BP} PROCEDURE FillWord(VAR Data;Count,Value:WORD); PROCEDURE dosmemfillword(Segx,xofs,Count,Value:WORD); PROCEDURE dosmemput(Segx,xofs:WORD;VAR Data;Count:WORD); PROCEDURE dosmemget(Segx,xofs:WORD;VAR Data;Count:WORD); FUNCTION inportb(portx : word) : byte; PROCEDURE outportb(portx : word;data : byte); FUNCTION inportw(portx : word) : word; PROCEDURE outportw(portx : word;data : word); FUNCTION inportl(portx : word) : longint; PROCEDURE outportl(portx : word;data : longint); {$ENDIF} IMPLEMENTATION Uses {$ifdef Win32Graph} WinMouse, {$undef MouseApi} {$else} {$IFDEF MouseAPI} Mouse, {$ELSE} MSMouse, {$ENDIF} {$endif} {$ifdef UseGraphics} Graph, {$endif} {$ifdef Win32Graph} WinCrt, {$else} Crt, {$endif} Dos; VAR DefColor : BYTE; {Backup of startup colors} CONST {The initial names. If people feel they are missing, I first checked the Alias, and then filled with names of the FPC-Devel list, and arranged them alfabetically} InitNames : ARRAY[0..9] OF String[12] = ('Carl','Daniel','Florian','Jonas','John','Marco','Michael (3x)', 'Peter','Pierre','Thomas' ); FUNCTION MousePresent : BOOLEAN; BEGIN {$IFDEF MouseAPI} MousePresent:=DetectMouse<>0; {$ELSE} MousePresent:=MouseFound; {$ENDIF} END; PROCEDURE ShowMouse; BEGIN {$ifdef Win32Graph} WinMouse.ShowMouse; {$else} {$IFDEF MouseAPI} Mouse.ShowMouse; {$ELSE} MsMouse.ShowMouse; {$ENDIF} {$endif} END; PROCEDURE HideMouse; BEGIN {$ifdef Win32Graph} WinMouse.HideMouse; {$else} {$IFDEF MouseAPI} Mouse.HideMouse; {$ELSE} MsMouse.HideMouse; {$ENDIF} {$endif} END; PROCEDURE InitMouse; BEGIN {$ifdef Win32Graph} WinMouse.InitMouse; {$else} {$IFDEF MouseAPI} Mouse.InitMouse; {$ELSE} MsMouse.InitMouse; {$ENDIF} {$endif} END; PROCEDURE DoneMouse; BEGIN {$ifdef Win32Graph} {$else} {$IFDEF MouseAPI} Mouse.DoneMouse; {$ENDIF} {$endif} END; PROCEDURE GetMouseState(VAR MX,MY,MState : LONGINT); {$IFDEF MouseAPI} VAR MouseEvent : TMouseEvent; {$ENDIF} BEGIN {$IFDEF MouseAPI} GetMouseEvent(MouseEvent); MX:=MouseEvent.X SHL 3; MY:=MouseEvent.Y SHL 3; MState:=MouseEvent.Buttons; {$ELSE} {$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; Procedure LoadHighScore(FileName:STRING); var F: File; I : LONGINT; OFileMode : LONGINT; BEGIN {$I-} Assign(F, FileName); OFileMode:=FileMode; FileMode := 0; {Set file access to read only } Reset(F); Close(F); {$I+} IF IOResult=0 THEN ScorePath:=FileName ELSE ScorePath:=FSearch(FileName,GetEnv('PATH')); IF ScorePath='' THEN BEGIN FOR I:=0 TO 9 DO BEGIN HighScore[I].Name:=InitNames[I]; If Negative Then HighScore[I].Score:=-100*(10-I) Else HighScore[I].Score:=(I+1)*750; END; ScorePath:=FileName; END ELSE BEGIN Assign(F,ScorePath); Reset(F,1); BlockRead(F,HighScore,SIZEOF(HighScoreArr)); Close(F); END; FileMode:=OFileMode; END; Procedure SaveHighScore; var F: File; BEGIN Assign(F,ScorePath); Rewrite(F,1); BlockWrite(F,HighScore,SIZEOF(HighScoreArr)); Close(F); END; FUNCTION SlipInScore(Score:LONGINT):LONGINT; VAR I,J : LONGINT; BEGIN IF Negative THEN Score:=-Score; I:=0; WHILE (Score>HighScore[I].Score) AND (I<10) DO INC(I); IF I<>0 THEN BEGIN IF I>1 THEN FOR J:=0 TO I-2 DO HighScore[J]:=HighScore[J+1]; HighScore[I-1].Score:=Score; HighScore[I-1].Name:=''; END; SlipInScore:=I; END; {$IFDEF UseGraphics} PROCEDURE ShowHighScore; VAR I : LONGINT; S : String; BEGIN SetFillStyle(SolidFill,0); {Clear part of playfield} Bar(HighX,HighY, 638, HighY+20+18*LineDistY); FOR I:=0 TO 9 DO BEGIN OutTextXY(HighX,HighY+(9-I)*LineDistY,HighScore[I].Name); IF Negative THEN Str((-HighScore[I].Score):5,S) ELSE Str(HighScore[I].Score:5,S); OutTextXY(HighX+150,HighY+(9-I)*LineDistY,S); END; END; {$ELSE} PROCEDURE ShowHighScore; VAR I : LONGINT; {HighX=40 HighY=9} BEGIN GotoXY(HighX+5,9); Write('The Highscores'); FOR I:=0 TO 9 DO BEGIN GotoXY(HighX,HighY+11-I); Write(HighScore[I].Name,' ':(13-Length(HighScore[I].Name)),' '); IF NOT Negative THEN { Negative=true-> better scores are lower} Write(HighScore[I].Score:5) ELSE Write(-HighScore[I].Score:5) END; END; {$ENDIF} FUNCTION GetKey:LONGINT; VAR InKey: LONGINT; BEGIN InKey:=ORD(ReadKey); IF InKey=0 THEN InKey:=ORD(ReadKey) SHL 8; GetKey:=InKey; END; {$IFNDEF UseGraphics} FUNCTION InputStr(VAR S:String;X,Y,Len:LONGINT;TextIn:BOOLEAN;CharAllow:CHARSET):BOOLEAN; { Input a string from keyboard, in a nice way, allowed characters are in CHARSET CharAllow, but several editting keys are always allowed, see CASE loop. Parameters: X,Y Coordinates field Len Length field TextIn S already filled?} VAR InGev : LONGINT; { No. of chars inputted } Posi : LONGINT; { Cursorposition} Ins : BOOLEAN; { Insert yes/no} Key : LONGINT; { Last key as ELib.GetKey code <255 if normal key, >256 if special/function key. See keys.inc} Uitg : String; {The inputted string} Full : BOOLEAN; { Is the string full? } EndVal : WORD; PROCEDURE ReWr; { Rewrite the field, using Uitg} VAR I : LONGINT; { Temporary variabele } BEGIN IF Length(Uitg)>Len THEN Uitg[0]:=CHR(Len); IF Length(Uitg)>0 THEN FOR I:= 1 TO Length(Uitg) DO BEGIN GotoXY(X+I-1,Y); IF Uitg[I]=CHR(32) THEN Write(FieldSpace) ELSE Write(Uitg[I]); END; IF Len<>Length(Uitg) THEN BEGIN GotoXY(X+Length(Uitg),Y); FOR I:= Length(Uitg) TO Len-1 DO Write(FieldSpace); END; END; PROCEDURE DoCursor; { Put Cursor in/out insert-mode } BEGIN {$IFNDEF Unix} { IF Ins THEN SetCursorSize($11E) ELSE SetCursorSize($71E); } {$ENDIF} END; BEGIN { Init } InGev :=0; { 0 chars untill now } Posi :=1; { Cursorposition 0 } Ins :=TRUE; { Insert according to parameters } DoCursor; { Set cursor accordingly } Key :=0; { put ħħħ padded field on screen } FillChar(Uitg,Len+1,FieldSpace); Uitg[0]:=CHR(Len); ReWr; GotoXY(X,Y); FillChar(Uitg,Len,32); UitG[0]:=#0; IF TextIn THEN BEGIN Uitg:=S; Posi:=Length(Uitg)+1; { Put a predefined } ReWr; { String on screen if specified } END; EndVal:=0; WHILE EndVal=0 DO BEGIN Full:=FALSE; IF ((Posi)>=Len) THEN BEGIN Full:=TRUE; Posi:=Len; END; GotoXY(X+Posi-1,Y); {$IFNDEF Unix} {$IFDEF FPC} {$ifndef Win32Graph} CursorOn; {$endif} {$ENDIF} DoCursor; {$ENDIF} Key:=GetKey; {$IFNDEF Unix} {$IFDEF FPC} {$ifndef Win32Graph} CursorOff; {$endif} {$ENDIF} {$ENDIF} CASE Key OF CR : BEGIN EndVal:=1; S:=UitG; END; ESC : EndVal:=2; BS : IF Posi>1 THEN { BackSpace } BEGIN DEC(Posi); Delete(Uitg,Posi,1); DEC(InGev); ReWr; END; KDelete : BEGIN Delete(Uitg,Posi,1); DEC(InGev); ReWr; END; ArrR : IF (NOT Full) AND ((Posi-1)Len THEN Posi:=Len; IF (Ins=FALSE) OR Full THEN BEGIN IF (ORD(Uitg[0])256 if special/function key. See keys.inc} Uitg : String; {The inputted string} Full : BOOLEAN; { Is the string full? } EndVal : WORD; PROCEDURE ReWr; { Rewrite the field, using Uitg} VAR I : LONGINT; { Temporary variabele } S : String; BEGIN FillChar(S[1],Len,FieldSpace); S:=Uitg; IF Length(Uitg)>Len THEN SetLength(Uitg,Len); SetLength(S,Len); IF Length(S)>0 THEN BEGIN FOR I:= 1 TO Length(S) DO IF S[I]=CHR(32) THEN S[I]:=FieldSpace; SetFillStyle(SolidFill,0); Bar(X,Y,X+Len*Dx+5,Y+Dy+1); OutTextXY(X,Y,S); END; END; PROCEDURE DoCursor; { Put Cursor in/out insert-mode } BEGIN {$IFNDEF Unix} { IF Ins THEN SetCursorSize($11E) ELSE SetCursorSize($71E); } {$ENDIF} END; BEGIN { Init } InGev :=0; { 0 chars untill now } Posi :=1; { Cursorposition 0 } Ins :=TRUE; { Insert according to parameters } DoCursor; { Set cursor accordingly } Key :=0; // SetFillStyle(SolidFill,0); // Bar(X,Y,X+Len*Dx+5,Y+Dy+1); { put ħħħ padded field on screen } FillChar(Uitg,Len+1,FieldSpace); Uitg[0]:=CHR(Len); ReWr; // GotoXY(X,Y); FillChar(Uitg,Len,32); SetLength(UitG,0); IF TextIn THEN BEGIN Uitg:=S; Posi:=Length(Uitg)+1; { Put a predefined } ReWr; { String on screen if specified } END; EndVal:=0; WHILE EndVal=0 DO BEGIN Full:=FALSE; IF ((Posi)>=Len) THEN BEGIN Full:=TRUE; Posi:=Len; END; {$IFNDEF Unix} {$IFDEF FPC} {$ifndef Win32Graph} CursorOn; {$endif} {$ENDIF} DoCursor; {$ENDIF} Key:=GetKey; {$IFNDEF Unix} {$IFDEF FPC} {$ifndef Win32Graph} CursorOff; {$endif} {$ENDIF} {$ENDIF} CASE Key OF CR : BEGIN EndVal:=1; S:=UitG; END; ESC : EndVal:=2; BS : IF Posi>1 THEN { BackSpace } BEGIN DEC(Posi); Delete(Uitg,Posi,1); DEC(InGev); ReWr; END; KDelete : BEGIN Delete(Uitg,Posi,1); DEC(InGev); ReWr; END; ArrR : IF (NOT Full) AND ((Posi-1)Len THEN Posi:=Len; IF (Ins=FALSE) OR Full THEN BEGIN IF (Length(Uitg) better scores are lower} END. { $Log$ Revision 1.8 2002-09-07 15:06:35 peter * old logs removed and tabs fixed Revision 1.7 2002/06/02 17:34:21 marco * Renamefest Revision 1.6 2002/06/02 09:49:17 marco * Renamefest Revision 1.5 2002/02/25 12:23:05 marco * Fixes for Quad Win32 GUI mode Revision 1.4 2002/02/22 21:40:09 carl * fix compilation problem }