home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1988-02-17 | 5.4 KB | 227 lines |
-
- IMPLEMENTATION MODULE RightControlPortIO; (* M2Amiga *)
- (* $S-, $R-, $F- keine Stackueberlaufskontrolle,
- keine Bereichskontrolle,
- keine Funktionsrueckgabekontrolle
- *)
- FROM Arts IMPORT Assert;
- FROM Exec IMPORT OpenResource;
- FROM SYSTEM IMPORT ADDRESS, ADR, BYTE, BITSET, CAST, INLINE,
- LONGSET, REG, SETREG, SHIFT;
-
- TYPE PotgoBits = (START, P1, P2, P3, P4, P5, P6, P7,
- DATLX, OUTLX, DATLY, OUTLY,
- DATRX, (* pin 5 *)
- OUTRX, (* vgl. Hardware Manual A-9 *)
- DATRY, (* pin 9 *)
- OUTRY);
-
- CONST RequestedBits = LONGSET{ORD(DATRX)..ORD(OUTRY)};
- (* beide Kanaele *)
-
- VAR AllocatedBits : LONGSET;
- PotgoBase : ADDRESS;
-
-
- TYPE
- ShortSet = SET OF [0..7];
- Pad = ARRAY[0..253] OF BYTE;
-
- VAR
- CIA[0BFE001H] : RECORD
- ciapra : ShortSet; pad0 : Pad;
- ciaprb : ShortSet; pad1 : Pad;
- ciaddra: ShortSet;
- END;
-
- (* Basisroutinen fuer PotGo-IO **************************************
- werden im externen Modul "Resources" bereitgehalten, das nicht
- fehlerfrei arbeitet
- *)
- MODULE Resource;
-
- IMPORT ADDRESS, ADR, BYTE, CAST, INLINE, LONGSET, REG, SETREG, SHIFT;
-
- EXPORT AllocPotBits, FreePotBits, WritePotgo;
-
-
- CONST
- AllocPotBitsVec = -6;
- WritePotgoVec = -18; (* vgl. Manual "Exec", S. D-8 *)
- FreePotBitsVec = -12;
-
- D0 = 0; D1 = 1; A6 = 14; JSRA6 = 4EAEH;
-
-
- PROCEDURE AllocPotBits(Base:ADDRESS; bits: LONGSET): LONGSET;
-
- BEGIN
- SETREG(D0,bits);
- SETREG(A6,Base);
- INLINE(JSRA6,AllocPotBitsVec);
- RETURN CAST(LONGSET, REG(D0))
- END AllocPotBits;
-
-
- PROCEDURE FreePotBits(Base:ADDRESS; bits: LONGSET);
-
- BEGIN
- SETREG(D0,bits);
- SETREG(A6,Base);
- INLINE(JSRA6,FreePotBitsVec);
- END FreePotBits;
-
-
- PROCEDURE WritePotgo(Base:ADDRESS; word, mask: LONGSET);
-
- BEGIN
- SETREG(D0,word);
- SETREG(D1,mask);
- SETREG(A6,Base);
- INLINE(JSRA6,WritePotgoVec);
- END WritePotgo;
-
- END Resource;
-
- (* Bidirectinal PotGoIO ******************************************)
-
- PROCEDURE WriteToPotPin(Pin : PotPinNumbers; Value : Level);(*WP*)
-
- VAR DatBit : CARDINAL;
- Word,
- Mask : LONGSET;
-
- BEGIN
- CASE Pin OF
- R5 : Mask := LONGSET{ORD(DATRX), ORD(OUTRX)};
- DatBit := ORD(DATRX);
- | R9 : Mask := LONGSET{ORD(DATRY), ORD(OUTRY)};
- DatBit := ORD(DATRY);
- END;
- Word := Mask;
- IF Value = Low THEN
- Word := Word - LONGSET{DatBit};(*EXCL(Word, DatBit);*)
- END;
- WritePotgo(PotgoBase, Word, Mask);
- END WriteToPotPin;
-
-
- PROCEDURE ReadFromPotPin(Pin : PotPinNumbers) : Level;(*RP*)
-
- TYPE PotgoBitSet = SET OF PotgoBits;
- VAR PotgoRead[0DFF016H] : PotgoBitSet; (* Wortbreite ein MUSS! *)
- DatBit : PotgoBits;
-
- BEGIN
- WriteToPotPin(Pin, High); (* Input auf High setzen, da active low *)
- IF Pin = R5 THEN
- DatBit := DATRX
- ELSE
- DatBit := DATRY
- END;
- IF DatBit IN PotgoRead THEN
- RETURN High
- ELSE
- RETURN Low
- END;
- END ReadFromPotPin;
-
-
- PROCEDURE CancelPotGoAccess;
- BEGIN
- FreePotBits(PotgoBase, AllocatedBits);
- END CancelPotGoAccess;
-
-
- PROCEDURE EnablePotGoAccess;
- BEGIN
- AllocatedBits := LONGSET{};
- PotgoBase := OpenResource(ADR("potgo.resource"));
- IF PotgoBase # NIL THEN
- AllocatedBits := AllocPotBits(PotgoBase, RequestedBits);
- END;
- IF (RequestedBits <= AllocatedBits) THEN
- RightPotgoOpen := TRUE;
- ELSE
- RightPotgoOpen := FALSE;
- CancelPotGoAccess;
- END;
- Assert(RightPotgoOpen = TRUE, ADR("Potgo not open"));
- END EnablePotGoAccess;
-
-
-
- (* Input from Joystick switches R1, R2, R3 und R4 *********************)
-
- PROCEDURE ReadJoystick(Pin : JoyPinNumbers) : Level;
-
- CONST Right = 1;
- Left = 9;
-
- VAR Joy1Dat[0DFF00CH] : BITSET;
- DatBit : CARDINAL;
-
- PROCEDURE Bit0XORBit1(Number : CARDINAL) : Level;
- BEGIN
- Number := Number MOD 4; (* untere 2 Bit isolieren *)
- IF (Number MOD 3) > 0 THEN (* Bit 0 XOR Bit 1 *)
- RETURN High
- ELSE
- RETURN Low
- END;
- END Bit0XORBit1;
-
- BEGIN
- CASE Pin OF
- (* FORWARD *)
- R1 : RETURN Bit0XORBit1(SHIFT(CAST(CARDINAL, Joy1Dat), -8));
- (* Back *)
- | R2 : RETURN Bit0XORBit1(CAST(CARDINAL, Joy1Dat));
- | R3 : DatBit := Left;
- | R4 : DatBit := Right;
- END;
- IF DatBit IN Joy1Dat THEN
- RETURN High
- ELSE
- RETURN Low
- END;
- END ReadJoystick;
-
-
- (*Bidirectional IO ueber Pin 6 *************************************)
- PROCEDURE WriteToPin6 (Input : Level);
- CONST gamePort1 = 7;
- BEGIN
- WITH CIA DO
- INCL(ciaddra, gamePort1);
- IF Input = High THEN
- INCL(ciapra, gamePort1)
- ELSE
- ciapra := ciapra - ShortSet{gamePort1};(*EXCL(ciapra, gamePort1)*)
- END;
- END;
- END WriteToPin6;
-
-
- PROCEDURE ReadFromPin6() : Level;
- CONST gamePort1 = 7;
- BEGIN
- WITH CIA DO
- (*EXCL(ciaddra, gamePort1);*)
- ciaddra := ciaddra - ShortSet{gamePort1};
- IF gamePort1 IN ciapra THEN
- RETURN High
- ELSE
- RETURN Low
- END;
- END;
- END ReadFromPin6;
-
-
- BEGIN
- EnablePotGoAccess;
- END RightControlPortIO.
-
-
- Listing 3