gameunit.pp 20 KB

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