home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 05 / amiga / m2amiga.3 < prev    next >
Encoding:
Modula Implementation  |  1988-02-17  |  5.4 KB  |  227 lines

  1.  
  2. IMPLEMENTATION MODULE RightControlPortIO; (* M2Amiga *)
  3. (* $S-, $R-, $F- keine Stackueberlaufskontrolle,
  4.                  keine Bereichskontrolle,
  5.                  keine Funktionsrueckgabekontrolle
  6. *)                 
  7. FROM Arts IMPORT Assert;
  8. FROM Exec IMPORT OpenResource;
  9. FROM SYSTEM IMPORT ADDRESS, ADR, BYTE, BITSET, CAST, INLINE,       
  10.                    LONGSET, REG, SETREG, SHIFT;
  11.         
  12. TYPE  PotgoBits     = (START, P1, P2, P3, P4, P5, P6, P7,
  13.                        DATLX, OUTLX, DATLY, OUTLY,
  14.                        DATRX, (* pin 5 *)
  15.                        OUTRX,     (* vgl. Hardware Manual A-9 *)
  16.                        DATRY, (* pin 9 *)
  17.                        OUTRY);
  18.       
  19. CONST RequestedBits = LONGSET{ORD(DATRX)..ORD(OUTRY)};
  20.                              (* beide Kanaele *)
  21.  
  22. VAR   AllocatedBits : LONGSET;
  23.       PotgoBase     : ADDRESS; 
  24.  
  25.  
  26. TYPE 
  27.     ShortSet = SET OF [0..7];
  28.     Pad      = ARRAY[0..253] OF BYTE;
  29.      
  30. VAR
  31.     CIA[0BFE001H] : RECORD
  32.                        ciapra : ShortSet; pad0 : Pad;
  33.                        ciaprb : ShortSet; pad1 : Pad;
  34.                        ciaddra: ShortSet;
  35.                     END;
  36.  
  37. (* Basisroutinen fuer PotGo-IO **************************************
  38.    werden im externen Modul "Resources" bereitgehalten, das nicht
  39.    fehlerfrei arbeitet
  40. *)
  41. MODULE Resource;
  42.  
  43. IMPORT ADDRESS, ADR, BYTE, CAST, INLINE, LONGSET, REG, SETREG, SHIFT;
  44.  
  45. EXPORT AllocPotBits, FreePotBits, WritePotgo;
  46.  
  47.  
  48. CONST
  49.   AllocPotBitsVec = -6;
  50.   WritePotgoVec   = -18; (* vgl. Manual "Exec", S. D-8 *)
  51.   FreePotBitsVec  = -12;
  52.  
  53.   D0 = 0;  D1 = 1;  A6 = 14; JSRA6 = 4EAEH;
  54.  
  55.  
  56. PROCEDURE AllocPotBits(Base:ADDRESS; bits: LONGSET): LONGSET;
  57.  
  58. BEGIN
  59.   SETREG(D0,bits);
  60.   SETREG(A6,Base);
  61.   INLINE(JSRA6,AllocPotBitsVec);
  62.   RETURN CAST(LONGSET, REG(D0))
  63. END AllocPotBits;
  64.  
  65.  
  66. PROCEDURE FreePotBits(Base:ADDRESS; bits: LONGSET);
  67.  
  68. BEGIN
  69.   SETREG(D0,bits);
  70.   SETREG(A6,Base);
  71.   INLINE(JSRA6,FreePotBitsVec);
  72. END FreePotBits;
  73.  
  74.  
  75. PROCEDURE WritePotgo(Base:ADDRESS; word, mask: LONGSET);
  76.   
  77. BEGIN
  78.   SETREG(D0,word);
  79.   SETREG(D1,mask);
  80.   SETREG(A6,Base);
  81.   INLINE(JSRA6,WritePotgoVec);
  82. END WritePotgo;
  83.    
  84. END Resource;
  85.  
  86. (* Bidirectinal PotGoIO ******************************************) 
  87.  
  88. PROCEDURE WriteToPotPin(Pin : PotPinNumbers; Value : Level);(*WP*)
  89.  
  90. VAR DatBit : CARDINAL;
  91.     Word,
  92.     Mask   : LONGSET;
  93.     
  94. BEGIN
  95.    CASE Pin OF
  96.       R5 : Mask   := LONGSET{ORD(DATRX), ORD(OUTRX)};
  97.            DatBit := ORD(DATRX);
  98.     | R9 : Mask   := LONGSET{ORD(DATRY), ORD(OUTRY)};
  99.            DatBit := ORD(DATRY);
  100.    END;
  101.    Word := Mask;
  102.    IF Value = Low THEN
  103.       Word := Word - LONGSET{DatBit};(*EXCL(Word, DatBit);*)
  104.    END;
  105.    WritePotgo(PotgoBase, Word, Mask);
  106. END WriteToPotPin;
  107.  
  108.  
  109. PROCEDURE ReadFromPotPin(Pin : PotPinNumbers) : Level;(*RP*)
  110.  
  111. TYPE PotgoBitSet         = SET OF PotgoBits;
  112. VAR  PotgoRead[0DFF016H] : PotgoBitSet; (* Wortbreite ein MUSS! *)
  113.      DatBit              : PotgoBits;
  114.     
  115. BEGIN
  116.    WriteToPotPin(Pin, High); (* Input auf High setzen, da active low *)
  117.    IF Pin = R5 THEN
  118.       DatBit := DATRX
  119.    ELSE
  120.       DatBit := DATRY
  121.    END;
  122.    IF DatBit IN PotgoRead THEN
  123.       RETURN High
  124.    ELSE
  125.       RETURN Low
  126.    END;
  127. END ReadFromPotPin;
  128.  
  129.  
  130. PROCEDURE CancelPotGoAccess;
  131. BEGIN
  132.    FreePotBits(PotgoBase, AllocatedBits);
  133. END CancelPotGoAccess;
  134.  
  135.  
  136. PROCEDURE EnablePotGoAccess;
  137. BEGIN
  138.    AllocatedBits := LONGSET{}; 
  139.    PotgoBase := OpenResource(ADR("potgo.resource"));
  140.    IF PotgoBase # NIL THEN
  141.       AllocatedBits := AllocPotBits(PotgoBase, RequestedBits);
  142.    END;   
  143.    IF (RequestedBits <= AllocatedBits) THEN
  144.       RightPotgoOpen := TRUE;
  145.    ELSE
  146.       RightPotgoOpen := FALSE;
  147.       CancelPotGoAccess;
  148.    END;   
  149.    Assert(RightPotgoOpen = TRUE, ADR("Potgo not open"));
  150. END EnablePotGoAccess;
  151.  
  152.   
  153.  
  154. (* Input from Joystick switches R1, R2, R3 und R4  *********************)
  155.  
  156. PROCEDURE ReadJoystick(Pin : JoyPinNumbers) : Level;
  157.  
  158. CONST Right = 1;
  159.       Left  = 9;
  160.  
  161. VAR Joy1Dat[0DFF00CH]  : BITSET;
  162.     DatBit             : CARDINAL;          
  163.  
  164. PROCEDURE Bit0XORBit1(Number : CARDINAL) : Level;
  165. BEGIN
  166.    Number := Number MOD 4;    (* untere 2 Bit isolieren *)
  167.    IF (Number MOD 3) > 0 THEN (* Bit 0 XOR Bit 1 *)
  168.       RETURN High
  169.    ELSE
  170.       RETURN Low
  171.    END;
  172. END Bit0XORBit1;
  173.  
  174. BEGIN
  175.    CASE Pin OF
  176.       (* FORWARD *)
  177.       R1 : RETURN Bit0XORBit1(SHIFT(CAST(CARDINAL, Joy1Dat), -8));
  178.       (* Back *)
  179.     | R2 : RETURN Bit0XORBit1(CAST(CARDINAL, Joy1Dat));
  180.     | R3 : DatBit := Left;
  181.     | R4 : DatBit := Right;
  182.    END;
  183.    IF DatBit IN Joy1Dat THEN
  184.       RETURN High
  185.    ELSE
  186.       RETURN Low
  187.    END; 
  188. END ReadJoystick;
  189.  
  190.  
  191. (*Bidirectional IO ueber Pin 6 *************************************)
  192. PROCEDURE WriteToPin6 (Input : Level);
  193. CONST gamePort1 = 7;
  194. BEGIN
  195.    WITH CIA DO
  196.       INCL(ciaddra, gamePort1);
  197.       IF Input = High THEN
  198.          INCL(ciapra, gamePort1)
  199.       ELSE
  200.          ciapra := ciapra - ShortSet{gamePort1};(*EXCL(ciapra, gamePort1)*)
  201.       END;
  202.    END;   
  203. END WriteToPin6;
  204.  
  205.  
  206. PROCEDURE ReadFromPin6() : Level;
  207. CONST gamePort1 = 7;
  208. BEGIN
  209.    WITH CIA DO
  210.       (*EXCL(ciaddra, gamePort1);*)
  211.       ciaddra := ciaddra - ShortSet{gamePort1};
  212.       IF gamePort1 IN ciapra THEN
  213.          RETURN High
  214.       ELSE
  215.          RETURN Low
  216.       END;
  217.    END;
  218. END ReadFromPin6;
  219.  
  220.  
  221. BEGIN
  222.    EnablePotGoAccess;
  223. END RightControlPortIO.
  224.  
  225.  
  226. Listing 3
  227.