home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / m2amiga.lzh / M2AMIGA / DEMOS / HITME.MOD < prev    next >
Encoding:
Text File  |  1991-08-16  |  4.9 KB  |  189 lines
  1. MODULE hitMe;
  2. (* This is the program published in AmigaWorld's March/April 1987 Issue.
  3.  * Playing with Intuition by William B. Catchings and mark L. Van Name.
  4.  * Ported to M2Amiga by Markus Schaub and Rene Degen.
  5.  *)
  6. (* Sorry, the program is too big for the demo compiler, I removed all
  7.  * inits to 0 of global data, done by Amiga Loader and switch all checks
  8.  * off $R- range check $V- overflow check $S- stack check $F- function return
  9.  *)
  10. FROM SYSTEM IMPORT
  11.  ADDRESS,ADR,INLINE,LONGSET,SHIFT;
  12. FROM Exec IMPORT
  13.  GetMsg,ReplyMsg,Wait;
  14. FROM Graphics IMPORT
  15.  Move,PolyDraw,SetAPen,Text;
  16. FROM Intuition IMPORT
  17.  selectUp,
  18.  IDCMPFlagSet,IDCMPFlags,IntuiMessagePtr,NewWindow,ScreenFlags,ScreenFlagSet,
  19.  WindowPtr,WindowFlags,WindowFlagSet,
  20.  ClearPointer,CloseWindow,CurrentTime,ModifyIDCMP,OpenWindow,
  21.  SetPointer,SetWindowTitles;
  22.  
  23. CONST
  24.  accuracy=3;
  25.  
  26. VAR
  27.  myWindow: WindowPtr;
  28.  message: IntuiMessagePtr;
  29.  class: IDCMPFlagSet;
  30.  code: CARDINAL;
  31.  ptrX, ptrY, boxX, boxY: INTEGER;
  32.  rand: INTEGER;
  33.  millis, oldMillis, score, total: LONGINT;
  34.  numHit: INTEGER;
  35.  corners: ARRAY [0..7] OF INTEGER;
  36.  waitMask, wom: LONGSET;
  37.  defWindow: NewWindow;
  38.  
  39. PROCEDURE WindCreate(VAR w: WindowPtr): BOOLEAN;
  40. BEGIN
  41.  WITH defWindow DO
  42.   leftEdge:=40; topEdge:=40;
  43.   width:=300; height:=100;
  44.   (*detailPen:=0;*) blockPen:=1;
  45.   (*title:=NIL;*)
  46.   flags:=WindowFlagSet{activate,windowClose,windowDrag,
  47.    windowSizing,windowDepth};
  48.   idcmpFlags:=IDCMPFlagSet{closeWindow};
  49.   type:=ScreenFlagSet{wbenchScreen};
  50. (*firstGadget:=NIL;
  51.   checkMark:=NIL;
  52.   screen:=NIL;
  53.   bitMap:=NIL; *)
  54.   minWidth:=100;
  55.   minHeight:=40;
  56.   maxWidth:=640;
  57.   maxHeight:=200
  58.  END;
  59.  w:=OpenWindow(defWindow);
  60.  RETURN w#NIL;
  61. END WindCreate;
  62.  
  63. PROCEDURE PtrData;
  64. (* $E- no Entry/Exit Code (of course not) *)
  65. BEGIN
  66.  INLINE(
  67.   0,0,
  68.   0FFFEH,0FFFEH,
  69.   0E10EH,0E00EH,
  70.   0E10EH,0E00EH,
  71.   0E10EH,0E00EH,
  72.   0E10EH,0E00EH,
  73.   0E10EH,0E00EH,
  74.   0FFFEH,0E00EH,
  75.   0E10EH,0E00EH,
  76.   0E10EH,0E00EH,
  77.   0E10EH,0E00EH,
  78.   0E10EH,0E00EH,
  79.   0E10EH,0E00EH,
  80.   0FFFEH,0FFFEH,
  81.   0,0)
  82. END PtrData;  
  83.  
  84. PROCEDURE WriteScore(w: WindowPtr; total,score,hits: LONGINT);
  85. VAR
  86.  st: ARRAY [0..15] OF CHAR;
  87.  i,l: INTEGER;
  88. BEGIN
  89.  st:="Hits:           "; i:=15; l:=hits;
  90.  IF l<0 THEN  st[i]:="-"; DEC(i); l:=-l END;
  91.  REPEAT
  92.   st[i]:=CHR(l MOD 10+48); l:=l DIV 10; DEC(i)
  93.  UNTIL (i=6) OR (l=0);
  94.  Move(w^.rPort, 10, 20);
  95.  Text(w^.rPort, ADR(st), 16);
  96.  st:="Score:          "; i:=15; l:=total;
  97.  IF l<0 THEN  st[i]:="-"; DEC(i); l:=-l END;
  98.  REPEAT
  99.   st[i]:=CHR(l MOD 10+48); l:=l DIV 10; DEC(i)
  100.  UNTIL (i=6) OR (l=0);
  101.  Move(w^.rPort, 10, 29);
  102.  Text(w^.rPort, ADR(st), 16);
  103. END WriteScore;
  104.  
  105. PROCEDURE Rand(): INTEGER;
  106. CONST
  107.  m=1024; a=57; c=6999;
  108. BEGIN
  109.  rand:=INTEGER((CARDINAL(a)*CARDINAL(rand)+CARDINAL(c)) MOD CARDINAL(m));
  110.  RETURN rand
  111. END Rand;
  112.  
  113. PROCEDURE PutBox(w: WindowPtr; VAR x,y: INTEGER; VAR millis: LONGINT);
  114. VAR
  115.  mic,sec: LONGCARD;
  116.  tmp: INTEGER;
  117. BEGIN
  118.  WITH w^ DO
  119.   IF millis=0 THEN
  120.    CurrentTime(ADR(sec),ADR(mic));
  121.    rand:=mic MOD 1024;
  122.   ELSE
  123.    SetAPen(rPort,0);
  124.    Move(rPort,corners[6],corners[7]);
  125.    PolyDraw(rPort,4,ADR(corners))
  126.   END;
  127.   SetAPen(rPort, 1);
  128.   REPEAT tmp:=Rand() UNTIL (tmp+20<width);  x:=tmp+10;
  129.   REPEAT tmp:=Rand() UNTIL (tmp+30<height); y:=tmp+20;
  130.   corners[0]:=x-4; corners[6]:=corners[0];
  131.   corners[1]:=y-3; corners[3]:=corners[1];
  132.   corners[2]:=x+4; corners[4]:=corners[2];
  133.   corners[5]:=y+3; corners[7]:=corners[5];
  134.   Move(rPort, corners[6], corners[7]);
  135.   PolyDraw(rPort,4,ADR(corners));
  136.   CurrentTime(ADR(sec), ADR(mic));
  137.   millis:=SHIFT(sec,10)+SHIFT(mic,-10)
  138.  END
  139. END PutBox;
  140.  
  141. PROCEDURE Hit(x1,y1,x2,y2: INTEGER): BOOLEAN;
  142. BEGIN
  143.  RETURN (ABS(x1-x2)<accuracy) & (ABS(y1-y2)<accuracy)
  144. END Hit;
  145.  
  146. BEGIN (*
  147.  millis:=0; oldMillis:=0; score:=0; total:=0; numHit:=0; *)
  148.  boxX:=50; boxY:=50;
  149.  IF WindCreate(myWindow) THEN
  150.   SetWindowTitles(myWindow, ADR('hitMe'), ADR('hitMe, 2.1, 4-Nov-87'));
  151.   ModifyIDCMP(myWindow, IDCMPFlagSet{mouseButtons, closeWindow, newSize});
  152.   SetPointer(myWindow, ADR(PtrData), 13, 16, -8, -6);
  153.   PutBox(myWindow, boxX, boxY, oldMillis);
  154.   WriteScore(myWindow, total, score, numHit);
  155.   waitMask:=LONGSET{myWindow^.userPort^.sigBit};
  156.   LOOP
  157.    wom:=Wait(waitMask);
  158.    message:=IntuiMessagePtr(GetMsg(myWindow^.userPort));
  159.    WHILE message#NIL DO
  160.     class:=message^.class;
  161.     code:=message^.code;
  162.     ptrX:=message^.mouseX;
  163.     ptrY:=message^.mouseY;
  164.     millis:=SHIFT(message^.seconds,10)+SHIFT(message^.micros,-10);
  165.     ReplyMsg(ADDRESS(message));
  166.     IF closeWindow IN class THEN
  167.      ClearPointer(myWindow);
  168.      CloseWindow(myWindow);
  169.      EXIT
  170.     ELSIF newSize IN class THEN
  171.      PutBox(myWindow,boxX,boxY,oldMillis);
  172.     ELSIF mouseButtons IN class THEN
  173.      IF code=selectUp THEN
  174.       IF Hit(ptrX,ptrY,boxX,boxY) THEN
  175.        score:=6000-(millis-oldMillis);
  176.        IF score<0 THEN score:=0 END;
  177.        score:=SHIFT(score,-4);
  178.        INC(total,score); INC(numHit);
  179.        WriteScore(myWindow,total,score,numHit);
  180.        PutBox(myWindow,boxX,boxY,oldMillis)
  181.       END
  182.      END
  183.     END; 
  184.     message:=IntuiMessagePtr(GetMsg(myWindow^.userPort));
  185.    END
  186.   END
  187.  END
  188. END hitMe.
  189.