gameunit.pp 20 KB

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