home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff338.lzh / SASTools / MCP / turboMCP.mod < prev    next >
Text File  |  1990-03-23  |  5KB  |  116 lines
  1. (***************************************************************************
  2. *  Programme : turboMCP.mod (not "Master Control Programme" but            *
  3. *                            "Modula-2 Cycle Power)                        *
  4. *  Usage     : turboMCP                                                    *
  5. *  Version   : V1.57                                                       *
  6. *  Date      : 22.-26.03.1989, 09.04.1989                                  *
  7. *  Author    : Jörg Sixt                                                   *
  8. *  Purpose   : a TRON-like game for two players                            *
  9. *  Language  : Modula-2,AMSoft  PD-Version from Fish 113                   *
  10. *  Bugs      : Can't use devices with the demo-version                     *
  11. ***************************************************************************)
  12.  
  13. MODULE turboMCP;
  14.  
  15. FROM SYSTEM    IMPORT ADR;
  16. FROM Intuition IMPORT ScreenPtr,NewScreen,ScreenFlagSet,OpenScreen,CloseScreen;
  17. FROM Graphics  IMPORT RastPortPtr,ViewModeSet,SetRast,Move,Text,SetAPen,
  18.                       ReadPixel,WritePixel,SetRGB4,ViewPortPtr ;
  19.  
  20. CONST   WHAT             = 200;
  21.  
  22. VAR  Taste [12577793] : CHAR;
  23.      Help             : ARRAY[0..25] OF CHAR ;
  24.      MyScrPtr         : ScreenPtr ;
  25.      MyNewScr         : NewScreen ;
  26.      Rast             : RastPortPtr ;
  27.      Viewer           : ViewPortPtr ;
  28.      x                : ARRAY [1..2] OF INTEGER [-1..320] ;
  29.      y                : ARRAY [1..2] OF INTEGER [-1..WHAT] ;
  30.      vx,vy            : ARRAY [1..2] OF INTEGER [-1..1] ;
  31.      Level            : INTEGER [1..10] ;
  32.      i                : INTEGER [1..2] ;
  33.      ExtraWurst       : LONGINT ;
  34.      crash            : BOOLEAN ;
  35.      Color            : INTEGER [-1..15] ;
  36.      Cycle            : INTEGER [-1..15] ;
  37.  
  38. PROCEDURE SleepTight ;
  39.      BEGIN
  40.           Help[0] := Taste ;
  41.           REPEAT  UNTIL (Help[0] # Taste) ;
  42.      END SleepTight ;
  43.  
  44.  
  45. BEGIN
  46.      WITH MyNewScr DO       (* My first Modula-Screen -> a historical moment !! *)
  47.         leftEdge     :=   0 ; topEdge  :=    0 ;
  48.         width        := 320 ; height   := WHAT ; depth := 2 ;
  49.         detailPen    :=   0 ; blockPen :=    0 ;
  50.         viewModes    := ViewModeSet   {} ;
  51.         type         := ScreenFlagSet {} ;
  52.         defaultTitle := NIL ; gadgets  := NIL  ; customBitMap := NIL ;
  53.      END ;
  54.  
  55.      MyScrPtr := OpenScreen (MyNewScr)   ;
  56.      IF (MyScrPtr = NIL) THEN HALT ; END ;
  57.      Rast     := ADR(MyScrPtr^.rastPort) ;
  58.      Viewer   := ADR(MyScrPtr^.viewPort) ;
  59.  
  60.      SetRGB4 (Viewer,0, 0, 0, 0) ; SetRGB4 (Viewer,1,15,15,15) ;
  61.      SetRGB4 (Viewer,2,15, 0, 0) ; SetRGB4 (Viewer,3, 0,15, 0) ;
  62.  
  63.      LOOP
  64.         SetAPen (Rast,1)   ;
  65.         Move (Rast,68, 80) ; Text (Rast,ADR("Modula  Cycle like  Power"),25) ;
  66.         Move (Rast,72,110) ; Text (Rast,ADR("by  sick amiga software")  ,23) ;
  67.         x[1]  :=  39   ; y[1]  := 100 ; vx[1] :=  0 ; vy[1] :=-1 ;
  68.         x[2]  := 279   ; y[2]  := 100 ; vx[2] :=  0 ; vy[2] :=-1 ;
  69.         crash := FALSE ; Level :=  10 ; Color := 15 ; SleepTight ;
  70.         REPEAT
  71.            CASE Taste OF
  72.             (* ESC    *) 165C : EXIT |
  73.             (* SPACE  *) 177C : SleepTight |
  74.             (* CTRL   *)  71C : SetRast (Rast,0) |
  75.             (* UP1    *) 333C : IF vy[1]=0 THEN vx[1]:= 0 ; vy[1]:=-1 ; END |
  76.             (* DOWN1  *) 233C : IF vy[1]=0 THEN vx[1]:= 0 ; vy[1]:= 1 ; END |
  77.             (* RIGHT1 *) 273C : IF vx[1]=0 THEN vx[1]:= 1 ; vy[1]:= 0 ; END |
  78.             (* LEFT1  *) 275C : IF vx[1]=0 THEN vx[1]:=-1 ; vy[1]:= 0 ; END |
  79.             (* UP2    *) 147C : IF vy[2]=0 THEN vx[2]:= 0 ; vy[2]:=-1 ; END |
  80.             (* DOWN2  *) 145C : IF vy[2]=0 THEN vx[2]:= 0 ; vy[2]:= 1 ; END |
  81.             (* RIGHT2 *) 143C : IF vx[2]=0 THEN vx[2]:= 1 ; vy[2]:= 0 ; END |
  82.             (* LEFT2  *) 141C : IF vx[2]=0 THEN vx[2]:=-1 ; vy[2]:= 0 ; END |
  83.             (* Funkey *) 115C..137C :
  84.                                 IF ODD(ORD(Taste)) THEN
  85.                                    Level := (ORD(Taste)-75) DIV 2;
  86.                                 END |
  87.            ELSE
  88.             (* otherwise the runtime system gets crazy *)
  89.            END;
  90.            FOR i := 1 TO 2 DO
  91.               x[i] := x[i]+vx[i] ; y[i] := y[i]+vy[i] ;
  92.               IF  x[i] =  -1  THEN x[i] :=    319 ; END ;
  93.               IF  x[i] = 320  THEN x[i] :=      0 ; END ;
  94.               IF  y[i] =  -1  THEN y[i] := WHAT-1 ; END ;
  95.               IF  y[i] = WHAT THEN y[i] :=      0 ; END ;
  96.               IF ReadPixel(Rast,x[i],y[i]) # 0 THEN
  97.                  SetAPen (Rast,1)      ; SetRGB4 (Viewer,1,15,15,15) ;
  98.                  crash    := TRUE      ; Help     := "Crash ! Looser is   " ;
  99.                  Help[19] := CHR(i+48) ; Help[20] := "!" ;
  100.                  Move (Rast,84,30)     ; Text (Rast,ADR(Help[0]),21) ;
  101.                  SleepTight            ; SetRast (Rast,0) ;
  102.               ELSE
  103.                  SetAPen(Rast,i+1) ;
  104.                  ExtraWurst := WritePixel(Rast,x[i],y[i]) ;
  105.               END ;
  106.            END;
  107.            IF Color = 15 THEN Cycle := -1 ; END ;
  108.            IF Color =  0 THEN Cycle :=  1 ; END ;
  109.            Color   := Color + Cycle ;
  110.            SetRGB4 (Viewer,1,Color,Color,Color) ;
  111.            FOR ExtraWurst := 0 TO Level*300 DO (* nothing *) END ;
  112.         UNTIL crash ;
  113.      END ;
  114.      CloseScreen (MyScrPtr) ;
  115. END turboMCP.
  116.