← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/gbaunits/gba_input.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/gbaunits/gba_input.pas
 
1
(*
 
2
  gba_input.pas 01/09/2006 19.57.16
 
3
  ------------------------------------------------------------------------------
 
4
  This lib is a raw porting of libgba library for gba (you can find it at
 
5
  http://www.devkitpro.org).
 
6
  
 
7
  As this is a direct port from c, I'm pretty sure that something could not work
 
8
  as you expect. I am even more sure that this code could be written better, so 
 
9
  if you think that I have made some mistakes or you have some better 
 
10
  implemented functions, let me know [francky74 (at) gmail (dot) com]
 
11
  Enjoy!
 
12
 
 
13
  Conversion by Legolas (http://itaprogaming.free.fr) for freepascal compiler
 
14
  (http://www.freepascal.org)
 
15
  
 
16
  Copyright (C) 2006  Francesco Lombardi
 
17
  
 
18
  This library is free software; you can redistribute it and/or
 
19
  modify it under the terms of the GNU Lesser General Public
 
20
  License as published by the Free Software Foundation; either
 
21
  version 2.1 of the License, or (at your option) any later version.
 
22
  
 
23
  This library is distributed in the hope that it will be useful,
 
24
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
25
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
26
  Lesser General Public License for more details.
 
27
  
 
28
  You should have received a copy of the GNU Lesser General Public
 
29
  License along with this library; if not, write to the Free Software
 
30
  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301 USA
 
31
  ------------------------------------------------------------------------------
 
32
*)
 
33
unit gba_input;
 
34
{$i def.inc}
 
35
interface
 
36
 
 
37
uses 
 
38
  gba_types, gba_regs;
 
39
 
 
40
 
 
41
 
 
42
const
 
43
  KEY_A: TKeyPadBits       = (1 shl 0);
 
44
  KEY_B: TKeyPadBits       = (1 shl 1);
 
45
  KEY_SELECT: TKeyPadBits  = (1 shl 2);
 
46
  KEY_START: TKeyPadBits   = (1 shl 3); 
 
47
  KEY_RIGHT: TKeyPadBits   = (1 shl 4);
 
48
  KEY_LEFT: TKeyPadBits    = (1 shl 5);
 
49
  KEY_UP: TKeyPadBits      = (1 shl 6);
 
50
  KEY_DOWN: TKeyPadBits    = (1 shl 7);
 
51
  KEY_R: TKeyPadBits       = (1 shl 8);
 
52
  KEY_L: TKeyPadBits       = (1 shl 9);
 
53
 
 
54
  KEYIRQ_ENABLE: TKeyPadBits = (1 shl 14);
 
55
  KEYIRQ_OR: TKeyPadBits     = (0 shl 15);
 
56
  KEYIRQ_AND: TKeyPadBits    = (1 shl 15);
 
57
  DPAD: TKeyPadBits          = (1 shl 6) or (1 shl 7) or (1 shl 5) or (1 shl 4);
 
58
 
 
59
 
 
60
 
 
61
type
 
62
  KeyInput = packed record
 
63
    Up: word;
 
64
    Down: word;
 
65
    Held: word;
 
66
    Last: word;
 
67
    DownRepeat: word;
 
68
  end;
 
69
  TKeyInput = KeyInput;
 
70
//---------------------------------------------------------------------------------
 
71
// Global variables
 
72
//---------------------------------------------------------------------------------
 
73
 
 
74
var
 
75
  Keys: TKeyInput;
 
76
  delay: byte = 60;
 
77
  rept: byte = 30; 
 
78
  count: byte = 60;
 
79
 
 
80
procedure ScanKeys();
 
81
function KeysDown(): word;
 
82
function KeysDownRepeat(): word;
 
83
function KeysUp(): word;
 
84
function KeysHeld(): word;
 
85
procedure SetRepeat(SetDelay, SetRepeat: integer);
 
86
 
 
87
 
 
88
 
 
89
 
 
90
implementation
 
91
 
 
92
procedure SetRepeat(SetDelay, SetRepeat: integer);
 
93
begin
 
94
  delay := SetDelay;
 
95
  rept := SetRepeat;
 
96
end;
 
97
 
 
98
//---------------------------------------------------------------------------------
 
99
procedure ScanKeys();
 
100
var
 
101
  pressed, released: word;
 
102
begin
 
103
  Keys.Last := Keys.Held;
 
104
  Keys.Held := (REG_KEYINPUT^ and $03ff) xor $03ff; // upper 6 bits clear on hw not emulated
 
105
 
 
106
 
 
107
        pressed := Keys.Held and ( Keys.Last xor $03ff);
 
108
 
 
109
        Keys.DownRepeat := Keys.DownRepeat or pressed;
 
110
        Keys.Down := Keys.Down or pressed;
 
111
 
 
112
 
 
113
        released := ((Keys.Held xor $03ff) and Keys.Last);
 
114
 
 
115
        Keys.Up := Keys.Up or released;
 
116
 
 
117
        Keys.Down := Keys.Down and not released;
 
118
        Keys.DownRepeat := Keys.DownRepeat and not released;
 
119
 
 
120
        Keys.Up := Keys.Up and not pressed;
 
121
 
 
122
        if ( Keys.Last <> Keys.Held) then 
 
123
    count := delay;
 
124
 
 
125
 
 
126
        if ( delay <> 0) then
 
127
        begin
 
128
                dec(count);
 
129
                if (count = 0) then
 
130
                begin
 
131
                        count := rept;
 
132
                        Keys.DownRepeat := Keys.DownRepeat or Keys.Held;
 
133
                end;
 
134
        end;
 
135
end;
 
136
 
 
137
function KeysDownRepeat(): word;
 
138
var
 
139
        tmp: word; 
 
140
begin
 
141
  tmp := Keys.DownRepeat;
 
142
        Keys.DownRepeat := 0;
 
143
 
 
144
        KeysDownRepeat := tmp;
 
145
end;
 
146
 
 
147
function KeysDown(): word;
 
148
var
 
149
  tmp: word;
 
150
begin
 
151
  tmp := Keys.Down;
 
152
  Keys.Down := 0;
 
153
 
 
154
        KeysDown := tmp;
 
155
end;
 
156
 
 
157
function KeysUp(): word;
 
158
var
 
159
  tmp: word;
 
160
begin
 
161
  tmp := Keys.Up;
 
162
        Keys.Up := 0;
 
163
 
 
164
        KeysUp := tmp;
 
165
end;
 
166
 
 
167
function KeysHeld(): word;
 
168
begin
 
169
  KeysHeld := Keys.Held;
 
170
end;
 
171
 
 
172
end.