home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / amigae / e_v3.2a / src / game / race.e
Text File  |  2001-03-31  |  8KB  |  302 lines
  1. /* computer version of autorace game 
  2.  
  3.    Just play it too see how it works. The objective is to
  4.    balance speed so that you drive fast without bumping into
  5.    things. If you drive too fast to be able to take a curve,
  6.    you loose. This game is easy to play on paper, too.
  7.    Apart from that you can design some nice curves with it :-)
  8.  
  9. */
  10.  
  11. OPT OSVERSION=37
  12.  
  13. MODULE 'tools/clonescreen', 'gadtools', 'libraries/gadtools',
  14.        'intuition/screens', 'graphics/text', 'intuition/intuition',
  15.        'graphics/rastport'
  16.  
  17. CONST MAXP=10,
  18.       MAXBOUND=1000,
  19.       MAXTRAS=50000,
  20.       OFF=7
  21. CONST MAXAREA=MAXBOUND*5+10,
  22.       OURIDCMP=IDCMP_MENUPICK+IDCMP_MOUSEMOVE+IDCMP_MOUSEBUTTONS
  23.  
  24. DEF xres=60,yres=40,xpixel,ypixel,xoff=20,yoff,xsize,ysize,window=NIL,
  25.     curx[MAXP]:LIST, cury[MAXP]:LIST, lastx[MAXP]:LIST, lasty[MAXP]:LIST,
  26.     players=2,curp,stat,midx,midy,pointx,pointy,p[18]:LIST,
  27.     kx1,kx2,ky1,ky2,boundary[MAXBOUND]:LIST,area[MAXAREA]:ARRAY,
  28.     ainfo:areainfo,tras:tmpras,nogreen=FALSE
  29.  
  30. PROC main()
  31.   DEF screen=NIL:PTR TO screen,font=NIL:PTR TO textfont,depth,title,menu,visual
  32.   title:='AutoRace v0.1'
  33.   IF gadtoolsbase:=OpenLibrary('gadtools.library',37)
  34.     screen,window,font:=openscreenwindow(title)
  35.     IF screen
  36.       font:=Long(stdrast+52)
  37.       depth,xsize,ysize:=getcloneinfo(screen)
  38.       yoff:=screen.wbortop+font.ysize+1+30
  39.       xpixel:=xsize-10-xoff/xres
  40.       ypixel:=ysize-10-yoff/yres
  41.       SetColour(screen,0,$04,$C2,$73)
  42.       SetColour(screen,1,$00,$00,$00)
  43.       SetColour(screen,2,$DF,$DF,$DF)
  44.       SetColour(screen,3,$E1,$5A,$03)
  45.       IF window
  46.         Colour(3,2)
  47.         TextF(10,20,'\d \d',xpixel,ypixel)
  48.         IF menu:=CreateMenusA([1,0,'Project',0,0,0,0,
  49.                                  2,0,'New','n',0,0,0,
  50.                                  2,0,'No Green','g',0,0,0,
  51.                                  2,0,'Quit','q',0,0,0,
  52.                                1,0,'Players',0,0,0,0,
  53.                                  2,0,'One','1',0,0,0,
  54.                                  2,0,'Two','2',0,0,0,
  55.                                  2,0,'Three','3',0,0,0,
  56.                                  2,0,'Four','4',0,0,0,
  57.                                  2,0,'Five','5',0,0,0,
  58.                                0,0,0,0,0,0,0]:newmenu,NIL)
  59.           IF visual:=GetVisualInfoA(screen,NIL)
  60.             IF LayoutMenusA(menu,visual,NIL)
  61.               IF SetMenuStrip(window,menu)
  62.                 loop()
  63.                 ClearMenuStrip(window)
  64.               ELSE
  65.                 WriteF('Could not set menustrip!\n')
  66.               ENDIF
  67.             ELSE
  68.               WriteF('Could not layout menus!\n')
  69.             ENDIF
  70.             FreeVisualInfo(visual)
  71.           ELSE
  72.             WriteF('Could not get visual infos!\n')
  73.           ENDIF
  74.           FreeMenus(menu)
  75.         ELSE
  76.           WriteF('Could not create menus!\n')
  77.         ENDIF
  78.       ELSE
  79.         WriteF('Could not open window!\n')
  80.       ENDIF
  81.     ELSE
  82.       WriteF('Could not open screen!\n')
  83.     ENDIF
  84.     closeclonescreen(screen,font,window)
  85.     CloseLibrary(gadtoolsbase)
  86.   ELSE
  87.     WriteF('Could not open gadtools v37+\n')
  88.   ENDIF
  89. ENDPROC
  90.  
  91. PROC openscreenwindow(t) HANDLE
  92.   DEF s=NIL,w=NIL,f=NIL
  93.   s,f:=openclonescreen('Workbench',t,3)
  94.   w:=backdropwindow(s,OURIDCMP,$1B00)
  95. EXCEPT
  96. ENDPROC s,w,f
  97.  
  98.  
  99. PROC wait4message(window:PTR TO window)
  100.   DEF mes:PTR TO intuimessage,type,infos
  101.   REPEAT
  102.     type:=0
  103.     IF mes:=Gt_GetIMsg(window.userport)
  104.       type:=mes.class
  105.       IF type=IDCMP_MENUPICK
  106.         infos:=mes.code
  107.         IF infos=-1 THEN type:=0
  108.       ELSEIF type=IDCMP_MOUSEBUTTONS
  109.         IF mes.code<>SELECTUP THEN type:=0
  110.       ELSEIF type=IDCMP_REFRESHWINDOW
  111.         Gt_BeginRefresh(window)
  112.         Gt_EndRefresh(window,TRUE)
  113.         type:=0
  114.       ENDIF
  115.       Gt_ReplyIMsg(mes)
  116.     ELSE
  117.       Wait(-1)
  118.     ENDIF
  119.   UNTIL type
  120. ENDPROC type,infos
  121.  
  122. ENUM NO_ACTION,SELECTING,GAME_OVER   -> stat
  123. CONST BACKC=2,FRONTC=1,PLAYERC=3,GRASSC=0
  124.  
  125. PROC loop() HANDLE
  126.   DEF quit=FALSE,class,infos,menu,item,rast:PTR TO rastport
  127.   ListCopy(boundary,[11,7, 24,5, 42,10, 45,16, 43,26, 39,29, 25,33, 10,30, 7,23, 6,17, 11,7])
  128.  
  129.   rast:=stdrast
  130.   rast.aolpen:=GRASSC
  131.   ->rast.flags:=rast.flags OR RPF_AREAOUTLINE
  132.   rast.tmpras:=InitTmpRas(tras,NewM(MAXTRAS,2),MAXTRAS)
  133.   InitArea(ainfo,area,MAXAREA)
  134.   rast.areainfo:=ainfo
  135.  
  136.   resetgame()
  137.   REPEAT
  138.     IF stat=NO_ACTION THEN startselection()
  139.     class,infos:=wait4message(window)  ->WaitIMessage(window) -> crashes?
  140.     SELECT class
  141.       CASE IDCMP_MENUPICK
  142.         menu:=infos AND %11111
  143.         item:=Shr(infos AND %11111100000,5)
  144.         SELECT menu
  145.           CASE 0
  146.             SELECT item
  147.               CASE 0; nogreen:=FALSE; resetgame()
  148.               CASE 1; nogreen:=TRUE;  resetgame()
  149.               CASE 2; quit:=TRUE
  150.             ENDSELECT
  151.           CASE 1
  152.             players:=item+1
  153.             resetgame()
  154.         ENDSELECT
  155.       CASE IDCMP_MOUSEMOVE
  156.         IF stat<GAME_OVER THEN updateselection()
  157.       CASE IDCMP_MOUSEBUTTONS
  158.         IF stat<GAME_OVER THEN finishselection()
  159.     ENDSELECT
  160.   UNTIL quit
  161. EXCEPT
  162.   WriteF('No mem for tmpras!\n')
  163. ENDPROC
  164.  
  165. PROC resetgame()
  166.   DEF x,y,a,l
  167.   Box(0,0,xsize-1,ysize-1,BACKC)
  168.   FOR x:=0 TO xres DO FOR y:=0 TO yres DO vplot(x,y,FRONTC)
  169.   Line(xcoord(0),ycoord(0),xcoord(15),ycoord(15),FRONTC)
  170.   Colour(GRASSC,BACKC)
  171.   IF nogreen=FALSE
  172.     AreaMove(stdrast,xcoord(boundary[0]),ycoord(boundary[1]))
  173.     l:=ListLen(boundary)
  174.     FOR a:=2 TO l-1 STEP 2 DO AreaDraw(stdrast,xcoord(boundary[a]),ycoord(boundary[a+1]))
  175.     AreaEnd(stdrast)
  176.   ENDIF
  177.   FOR a:=0 TO players-1
  178.     curx[a]:=OFF-a; cury[a]:=OFF-a; lastx[a]:=OFF-a; lasty[a]:=OFF-a
  179.   ENDFOR
  180.   stat:=NO_ACTION
  181.   curp:=0
  182. ENDPROC
  183.  
  184. PROC startselection()
  185.   DEF posm=0,a,b,pc:PTR TO LONG,distx,disty,x,y
  186.   midx:=curx[curp]-lastx[curp]+curx[curp]
  187.   midy:=cury[curp]-lasty[curp]+cury[curp]
  188.   pc:=p
  189.   stat:=SELECTING
  190.   FOR a:=-1 TO 1
  191.     FOR b:=-1 TO 1
  192.       IF valid(midx+a,midy+b)
  193.         posm++
  194.         pc[]++:=xcoord(midx+a)
  195.         pc[]++:=ycoord(midy+b)
  196.       ELSE
  197.         pc[]++:=0
  198.         pc[]++:=0
  199.       ENDIF
  200.     ENDFOR
  201.   ENDFOR
  202.   IF posm
  203.     message('player \d has \d possible move(s)',curp+1,posm)
  204.     plotplayer(curp)
  205.     x:=xcoord(midx); y:=ycoord(midy)
  206.     distx:=xpixel/2+xpixel
  207.     disty:=ypixel/2+ypixel
  208.     kx1:=x-distx
  209.     kx2:=x+distx
  210.     ky1:=y-disty
  211.     ky2:=y+disty
  212.     drawkader()
  213.     computemouse()
  214.     selectline(2)
  215.   ELSE
  216.     message('player \d looses!',curp+1,0)
  217.     stat:=GAME_OVER
  218.   ENDIF
  219. ENDPROC
  220.  
  221. PROC updateselection()
  222.   selectline(2)
  223.   computemouse()
  224.   selectline(2)
  225. ENDPROC
  226.  
  227. PROC finishselection()
  228.   selectline(2)
  229.   drawkader()
  230.   selectline(1)
  231.   vplot(curx[curp],cury[curp],FRONTC)
  232.   lastx[curp]:=curx[curp]
  233.   lasty[curp]:=cury[curp]
  234.   curx[curp]:=xvirtua(pointx)
  235.   cury[curp]:=yvirtua(pointy)
  236.   stat:=NO_ACTION
  237.   curp++
  238.   IF curp=players THEN curp:=0
  239.   plotplayer(curp)
  240. ENDPROC
  241.  
  242. PROC computemouse()
  243.   DEF pc:PTR TO LONG,a,x,y,mx,my
  244.   pc:=p
  245.   pointx:=pointy:=10000
  246.   mx:=MouseX(window)
  247.   my:=MouseY(window)
  248.   FOR a:=0 TO 8
  249.     x:=pc[]++; y:=pc[]++
  250.     IF x
  251.       IF (Abs(x-mx)+Abs(y-my))<(Abs(pointx-mx)+Abs(pointy-my))
  252.         pointx:=x; pointy:=y
  253.       ENDIF
  254.     ENDIF
  255.   ENDFOR
  256.   IF (pointx=10000) OR (pointy=10000)
  257.     pointx:=0
  258.     pointy:=0
  259.   ENDIF
  260. ENDPROC
  261.  
  262. PROC selectline(mode)
  263.   SetDrMd(stdrast,mode)
  264.   Line(xcoord(curx[curp]),ycoord(cury[curp]),pointx,pointy,FRONTC)
  265.   SetDrMd(stdrast,1)
  266. ENDPROC
  267.  
  268. PROC xcoord(vx) RETURN vx*xpixel+xoff
  269. PROC ycoord(vy) RETURN vy*ypixel+yoff
  270. PROC col(vx,vy) RETURN ReadPixel(stdrast,xcoord(vx),ycoord(vy))
  271. PROC valid(x,y) RETURN col(x,y)=FRONTC
  272. PROC xvirtua(x) RETURN x-xoff/xpixel
  273. PROC yvirtua(y) RETURN y-yoff/ypixel
  274.  
  275. PROC drawkader()
  276.   SetDrMd(stdrast,2)
  277.   Line(kx1,ky1,kx1,ky2,FRONTC)
  278.   Line(kx1,ky1,kx2,ky1,FRONTC)
  279.   Line(kx2,ky2,kx1,ky2,FRONTC)
  280.   Line(kx2,ky2,kx2,ky1,FRONTC)
  281.   SetDrMd(stdrast,1)
  282. ENDPROC
  283.  
  284. PROC vplot(vx,vy,col)
  285.   DEF x,y
  286.   x:=xcoord(vx)
  287.   y:=ycoord(vy)
  288.   Box(x,y,x+1,y+1,col)
  289. ENDPROC
  290.  
  291. PROC plotplayer(player)
  292.   DEF x,y
  293.   x:=xcoord(curx[player])
  294.   y:=ycoord(cury[player])
  295.   Box(x-1,y-1,x+2,y+2,PLAYERC+player)
  296. ENDPROC
  297.  
  298. PROC message(s,p1,p2)
  299.   TextF(10,30,'                                             ')
  300.   TextF(10,30,s,p1,p2)
  301. ENDPROC
  302.