home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga Shareware Floppies / ma46.dms / ma46.adf / Waz / waz.E < prev    next >
Text File  |  2002-10-23  |  11KB  |  362 lines
  1.                                /* Waz */
  2.           /* (C) 1995, Andrzej Jarmoniuk Software Development */
  3.  
  4. MODULE 'intuition/intuition', 'dos/dos', 'reqtools', 'libraries/reqtools',
  5. 'intuition/screens', 'exec/ports', 'exec/memory'
  6.  
  7. ENUM OK, BLAD
  8.  
  9. CONST MAX = 1000, LEWY_NAROZNIK_OKNA=70, GORNY_NAROZNIK_OKNA=50, 
  10. SZEROKOSC_OKNA_INFORMACYJNEGO=162, WYSOKOSC_OKNA_INFORMACYJNEGO=125, 
  11. WAZ=2, TLO=3, ZARCIE=1, KEY_ESC=69, KEY_Q=$10, KEY_LEFT=79, KEY_UP=76, 
  12. KEY_RIGHT=78, KEY_DOWN=77, KEY_SPACE=$40, KEY_P=$19, KEY_KPLEFT=$2D, 
  13. KEY_KPUP=$3E, KEY_KPRIGHT=$2F, KEY_KPDOWN=$1E, KEY_1=$01, KEY_2=$02, 
  14. KEY_3=$03
  15.  
  16. DEF szerokosc_okna, wysokosc_okna, lewy_naroznik_inf, wazwin=0:PTR TO window, 
  17. wazmw=0:PTR TO window, wazmsg:PTR TO intuimessage, wazclass, wazcode, dlugosc, 
  18. rozrost, poczatek, koniec, opoznienie=4, maxx, maxy, kwadx, kwady, vx, vy, tytul, 
  19. im_waz:image, im_zarcie:image, im_tlo:image, wazx[MAX]:ARRAY, wazy[MAX]:ARRAY
  20.  
  21.  
  22. PROC main() HANDLE
  23.         ustaw_tytul()
  24.         IF otworz()=FALSE THEN Raise(BLAD)
  25.  
  26.         inicjuj_losowanie()
  27.         przygotuj_okno_informacyjne()
  28.         przygotuj_kwadraty()
  29.  
  30.         REPEAT
  31.             od_nowa()
  32.             gra()
  33.         UNTIL koniec_gry(dlugosc)=NIL
  34.  
  35.         Raise(OK)
  36. EXCEPT
  37.     zamknij()
  38.     IF exception
  39.         DisplayBeep(NIL)
  40.         RETURN 10
  41.     ENDIF
  42. ENDPROC
  43.  
  44.  
  45. PROC wiad(tekst, argum)
  46. ENDPROC RtEZRequestA(tekst, 'Sprobuj|Zakoncz', argum, NIL, 
  47. [RTEZ_REQTITLE, 'Informacja', 
  48. RTEZ_FLAGS, EZREQF_CENTERTEXT])
  49.  
  50. PROC otworz() HANDLE
  51.  
  52.         proporcje()
  53.  
  54.         IF (reqtoolsbase:=OpenLibrary('reqtools.library', 34))=FALSE
  55.                 Raise(BLAD)
  56.         ENDIF
  57.  
  58.         WHILE (wazwin:=OpenWindow([LEWY_NAROZNIK_OKNA, GORNY_NAROZNIK_OKNA, 
  59.                 szerokosc_okna, wysokosc_okna, 
  60.                 0, 1,         /* detailpen i blockpen */
  61.                 IDCMP_RAWKEY + IDCMP_CLOSEWINDOW, 
  62.                 WFLG_ACTIVATE + WFLG_RMBTRAP + WFLG_GIMMEZEROZERO +
  63.                 WFLG_CLOSEGADGET + WFLG_DEPTHGADGET + WFLG_DRAGBAR +
  64.                 WFLG_NOCAREREFRESH, 
  65.                 NIL,         /* gadzety */
  66.                 NIL,         /* checkmark */
  67.                 tytul,       /* tytul okna */
  68.                 NIL,         /* ekran */
  69.                 NIL,         /* superbitmap */
  70.                 NIL, NIL,     /* minwidth i minheight */
  71.                 NIL, NIL,     /* maxwidth i maxheight */
  72.                 WBENCHSCREEN]:nw))=FALSE
  73.                 IF wiad('Nie moge otworzyc okna glownego.', NIL)=FALSE THEN Raise(BLAD)
  74.         ENDWHILE
  75.  
  76.         WHILE (wazmw:=OpenWindow([lewy_naroznik_inf, GORNY_NAROZNIK_OKNA, 
  77.                 SZEROKOSC_OKNA_INFORMACYJNEGO, WYSOKOSC_OKNA_INFORMACYJNEGO, 
  78.                 0, 1,         /* detailpen i blockpen */
  79.                 IDCMP_CLOSEWINDOW, 
  80.                 WFLG_RMBTRAP + WFLG_DEPTHGADGET + WFLG_DRAGBAR + WFLG_NOCAREREFRESH +
  81.                 WFLG_GIMMEZEROZERO, 
  82.                 NIL,         /* gadzety */
  83.                 NIL,         /* checkmark */
  84.                 tytul,       /* tytul okna */
  85.                 NIL,         /* ekran */
  86.                 NIL,         /* superbitmap */
  87.                 NIL, NIL,     /* minwidth i minheight */
  88.                 NIL, NIL,     /* maxwidth i maxheight */
  89.                 WBENCHSCREEN]:nw))=FALSE
  90.  
  91.                 IF wiad('Nie moge otworzyc okna informacyjnego.', NIL)=NIL THEN Raise(OK)
  92.         ENDWHILE
  93. EXCEPT
  94.         RETURN FALSE
  95. ENDPROC TRUE
  96.  
  97. PROC zamknij()
  98.         IF wazwin THEN CloseWindow(wazwin)
  99.         IF wazmw THEN CloseWindow(wazmw)
  100.         IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  101. ENDPROC
  102.  
  103. PROC inicjuj_losowanie()
  104. DEF mik
  105.  
  106.     CurrentTime(NIL, {mik})
  107.     Rnd(-mik)
  108. ENDPROC
  109.  
  110. PROC rysuj_zarcie()
  111.         DEF x, y
  112.         REPEAT
  113.                 x:=Rnd(maxx)
  114.                 y:=Rnd(maxy)
  115.         UNTIL czy_waz(x, y)=FALSE
  116.         zarcie(x, y)
  117. ENDPROC
  118.  
  119. PROC czy_zarcie(x, y)
  120. ENDPROC ReadPixel(wazwin.rport, x*kwadx, y*kwady)=ZARCIE
  121.  
  122. PROC czy_waz(x, y)
  123. ENDPROC ReadPixel(wazwin.rport, x*kwadx+1, y*kwady)=WAZ
  124.  
  125. PROC klawisz()
  126.         wazcode:=wazmsg.code
  127.  
  128.         SELECT wazcode
  129.                 CASE KEY_ESC
  130.                         Raise(OK)
  131.                 CASE KEY_Q
  132.                         Raise(OK)
  133.                 CASE KEY_LEFT
  134.                         vx:=-1; vy:=0
  135.                 CASE KEY_UP
  136.                         vx:=0; vy:=-1
  137.                 CASE KEY_RIGHT
  138.                         vx:=1; vy:=0
  139.                 CASE KEY_DOWN
  140.                         vx:=0; vy:=1
  141.                 CASE KEY_P
  142.                         pauza()
  143.                         RETURN FALSE
  144.                 CASE KEY_1
  145.                         opoznienie:=1
  146.                 CASE KEY_2
  147.                         opoznienie:=3
  148.                 CASE KEY_3
  149.                         opoznienie:=4
  150.                 DEFAULT
  151.                         RETURN FALSE
  152.        ENDSELECT
  153. ENDPROC TRUE
  154.  
  155. PROC pauza()
  156. ENDPROC RtEZRequestA('Pauza', 'Odpauzuj', NIL, NIL, 
  157.                         [RT_WINDOW, wazwin, 
  158.                         RTEZ_REQTITLE, tytul, 
  159.                         RTEZ_FLAGS, EZREQF_CENTERTEXT, 
  160.                         RT_REQPOS, REQPOS_TOPLEFTSCR])
  161.           
  162. PROC waz(x, y)
  163. /*    DrawImage(wazwin.rport, im_waz, x*kwadx, y*kwady)*/
  164.     SetAPen(wazwin.rport, WAZ)
  165.     RectFill(wazwin.rport, x*kwadx, y*kwady, x+1*kwadx-2, y+1*kwady-1)
  166. ENDPROC
  167.  
  168. PROC zarcie(x, y)
  169. /*     DrawImage(wazwin.rport, im_zarcie, x*kwadx, y*kwady)
  170. */    SetAPen(wazwin.rport, ZARCIE)
  171.     RectFill(wazwin.rport,x*kwadx,y*kwady, x+1*kwadx-2,y+1*kwady-1)
  172. ENDPROC
  173.  
  174. PROC tlo(x, y)
  175. /*    DrawImage(wazwin.rport, im_tlo, x*kwadx, y*kwady)
  176. */    SetAPen(wazwin.rport, TLO)
  177.     RectFill(wazwin.rport,x*kwadx,y*kwady,x+1*kwadx-2,y+1*kwady-1)
  178. ENDPROC
  179.             
  180. PROC przygotuj_kwadraty()
  181.     im_waz:=[0, 0, 
  182.                  kwadx-1, kwady, 0, 
  183.                  NIL, 
  184.                  %0, %10, 
  185.                  NIL]:image
  186.  
  187.     im_zarcie:=[0, 0, 
  188.                 kwadx-1, kwady, 0, 
  189.                 NIL, 
  190.                 %0, %01, 
  191.                 NIL]:image
  192.  
  193.     im_tlo:=[0, 0, 
  194.                 kwadx-1, kwady, 0, 
  195.                 NIL, 
  196.                 %0, %11, 
  197.                 NIL]:image
  198. ENDPROC TRUE
  199.  
  200. PROC proporcje()
  201.  
  202.         /* maksymalna ilosc kwadracikow */
  203.         maxx:=28
  204.         maxy:=28
  205.  
  206.         /* rozmiary kwadracika */
  207.         kwadx:=12
  208.         kwady:=6
  209.  
  210.  
  211.         /* to skutkuje,  ale trzeba bedzie zrobiê inaczej... */
  212.         szerokosc_okna:=maxx*kwadx+17
  213.         wysokosc_okna:=maxy*kwady+19
  214.  
  215.         lewy_naroznik_inf:=LEWY_NAROZNIK_OKNA+szerokosc_okna+1
  216.  
  217. ENDPROC
  218.  
  219. PROC koniec_gry(dane)
  220. ENDPROC RtEZRequestA('K O N I E C   G R Y\n\nWynik: %ld.\n\nGrasz od nowa???', 
  221. 'TAK!!!|Nie.', 
  222. NIL, 
  223. {dane}, 
  224. [RT_WINDOW, wazwin, 
  225. RTEZ_REQTITLE, tytul, 
  226. RTEZ_FLAGS, EZREQF_CENTERTEXT, 0])
  227.  
  228. PROC przygotuj_okno_informacyjne() HANDLE
  229.  
  230. CONST ROZMIAR = 4040 /* nie chce mi sië bawiê w Examine() itd. */
  231. /* ROZMIAR jest w bajtach */
  232.  
  233. DEF ic_obrazek:PTR TO INT, im_obrazek:image, f_obrazek
  234.  
  235.     SetStdRast(wazmw.rport)
  236.     Colour(1, 0)
  237.     WHILE (ic_obrazek:=AllocMem(ROZMIAR, MEMF_CHIP+MEMF_CLEAR))=FALSE
  238.         IF wiad('Nie mogë zaalokowaê pamiëci CHIP\ndla obrazka.', 0)=NIL THEN Raise(BLAD)
  239.     ENDWHILE
  240.  
  241.     WHILE (f_obrazek:=Open('PROGDIR:obrazek.dat', MODE_OLDFILE))=NIL
  242.         IF wiad('Nie mogë otworzyê pliku z danymi dla obrazka.', 0)=NIL THEN Raise(BLAD)
  243.     ENDWHILE
  244.  
  245.     Read(f_obrazek, ic_obrazek, ROZMIAR)
  246.  
  247.     im_obrazek:=[0, 0,      /* wewn. wspóîrzëdne */
  248.         150, 101, 2,      /* wymiary i gîëbokoôê */
  249.         ic_obrazek,        /* dane obrazka (z CHIPu) */
  250.         $0003, $0000,       /* maska bitowa aktywnych pîaszczyzn
  251.                              oraz m.b. pîaszczyzn nieaktywvych
  252.                              (w obrëbie tego obrazka */
  253.         NIL]:image        /* nastëpny obrazek */
  254.  
  255.     DrawImage(wazmw.rport, im_obrazek, 3, 1)
  256.  
  257.     Raise(OK)
  258. EXCEPT
  259.       IF exception THEN NOP
  260.       IF ic_obrazek THEN FreeMem(ic_obrazek, ROZMIAR)
  261.       TextF(20, 108, 'Wynik:')
  262. ENDPROC
  263.  
  264. PROC od_nowa()
  265.         SetRast(wazwin.rport, TLO)
  266.         TextF(115, 108, '    ')
  267. ENDPROC
  268.  
  269. PROC wynik(dane)
  270.         TextF(115, 108, '\d', dane)
  271. ENDPROC
  272.  
  273. /****************************************************************************/
  274. /****************************************************************************/
  275.  
  276. PROC gra() HANDLE
  277. DEF b_koniec = FALSE, 
  278.     x, y, x1, y1
  279.  
  280.         rysuj_zarcie()
  281.  
  282.         poczatek := 0; koniec := 0;
  283.  
  284.         wazx[poczatek]:=maxx/2
  285.         wazy[poczatek]:=maxy/2
  286.  
  287.         x:=wazx[poczatek]
  288.         y:=wazy[poczatek]
  289.  
  290.         dlugosc:=1
  291.  
  292.         waz(wazx[poczatek], wazy[poczatek])
  293.         wynik(dlugosc)
  294.  
  295.         REPEAT
  296.                 WaitPort(wazwin.userport)           /* to jest czekanie na */
  297.                 wazmsg:=GetMsg(wazwin.userport)     /* wcisniecie klawisza */
  298.                 ReplyMsg(wazmsg)
  299.                 IF wazmsg.class=IDCMP_CLOSEWINDOW THEN Raise(OK)
  300.         UNTIL klawisz()
  301.  
  302.         REPEAT
  303.                 
  304.                 REPEAT
  305.                     x1:=x; y1:=y
  306.                     IF wazmsg:=GetMsg(wazwin.userport)
  307.                         ReplyMsg(wazmsg)
  308.                         wazclass:=wazmsg.class
  309.                         SELECT wazclass
  310.                             CASE IDCMP_RAWKEY
  311.                                 klawisz()
  312.                                CASE IDCMP_CLOSEWINDOW
  313.                                 Raise(OK)
  314.                         ENDSELECT
  315.                        ENDIF
  316.                     x1 := x + vx
  317.                     y1 := y + vy
  318.                 UNTIL (x1>=0) AND (x1<=maxx) AND (y1>=0) AND (y1<=maxy)
  319.  
  320.                 x:=x1; y:=y1
  321.  
  322.                 IF czy_zarcie(x, y)
  323.                     rozrost := 2 + Rnd(10)
  324.                     rysuj_zarcie()
  325.                     tlo(x, y)
  326.                 ENDIF
  327.  
  328.                 IF (b_koniec:=czy_waz(x, y))=FALSE
  329.                         poczatek := Mod ( poczatek + 1,  MAX )
  330.  
  331.                         wazx[poczatek] := x
  332.                         wazy[poczatek] := y
  333.  
  334.                         waz(wazx[poczatek], wazy[poczatek])
  335.  
  336.                         IF rozrost
  337.                             rozrost--
  338.                             dlugosc++
  339.                             wynik(dlugosc)
  340.                         ELSE
  341.                             tlo(wazx[koniec], wazy[koniec])
  342.                             koniec := Mod( koniec + 1,  MAX )
  343.                         ENDIF
  344.                 ENDIF
  345.  
  346.                 Delay(opoznienie)
  347.         UNTIL b_koniec = TRUE
  348.  
  349.         Raise(OK)
  350.  
  351. EXCEPT
  352. ENDPROC
  353.  
  354. /****************************************************************************/
  355. /****************************************************************************/
  356.  
  357. PROC ustaw_tytul()
  358.     tytul:='Waz 2.3'
  359. ENDPROC
  360.  
  361. CHAR '$VER: Waz 2.3, © 1995, Andrzej Jarmoniuk', 0
  362.