Vika EDIT:
Nyt toimii :) Graafisella käyttöliittymällä. Minun mielestä ihan hyvin toimii. Tämä tästä projektista.
https://petke.info/labyrintti.exe
EDIT: Ohjelma näyttää vaativan 4K näytön, missä Promptin leveys on suurempi. Unohtakaa tämä merkkipohjainen ohjelma!! Teen graafisen käyttöliittymän.
Olet labyrintissa. Olet yhtenä pienenä kysymysmerkkinä keskellä suurta labyrinttia. Sinulla on hieman epäkunnossa oleva drone, mikä ei pysty lentämään kovin korkealle, mutta näet sen kameran avulla näkymän viidenkymmenen metrin korkeudelta kännykästäsi. Klikkaa nuolinäppäillä mihin suuntaan kävelet ja löydä tiesi ulos.
Windowssille exe: https://petke.info/labyrintti99.exe
Suo siellä vetelä täällä. Aluksi yritin ohjelmoida peliä Red-kielellä hienolla graafisella käyttöliittymällä, mutta se ei oikein sujunut, sitten yritin Javascript versiota, eikä sekään sujunut. Sitten yritin Red-merkkigrafiikkaa, mutta Red-kielessä ei kertakaikkiaan voida lukea näppäinpainallusta!? (no, ainakin sellaisen ohjelmoiminen lienee vaikeaa) Lopulta päädyin Free Pascalilla ohjelmoituun DOS-merkkigrafiikka versioon. Free Pascalilla vois vielä yrittää graafista käyttöliittymää, mutta nyt en jaksa, vaikka nyt kun DOS-Prompt peli on tehty, niin melko sutjakasti se voisi valmistua. Mañana, mañana - niinkuin espanjalaiset sanovat. Huomenna, huomenna.
Peli vaatii, että MS-Prompt ikkunaa pidetään mahdollisimman suurena. Äsken kokeilin käynnistää sitä klikkaamalla Windowsista, ni avasi liian pienen ikkunan ja ohjelma luuli jostain syystä siksi tyhjää kohtaa muuriksi..eli merkkien tulostuksessa ei kai rivin pituus riittänyt - en ny jääny pohtimaan. Pitää siis ensin mennä Promptiin, tehdä siitä iso ja käynnistää ohjelma.
Bugitiedotuksia otetaan mielellään vastaan. Yhden jo tiedänkin: ohjelma vain päättyy, eikä kirjoita:
IF lopussa THEN WRITELN('LOISTAVAA!! PÄÄSIT LABYRINTISTA ULOS');
Jos löytää tiensä ulos - en tiedä miksi.
Program labyrinttiuus;
uses winmouse,graph, wincrt,math,sysutils,DateUtils;
CONST xkoko = 60;
ykoko = 40;
maxstep = 999999;
TYPE
XTYPE = 1..xkoko;
YTYPE = 1..ykoko;
VAR labyrintti : ARRAY[1..xkoko,1..ykoko] OF smallInt;
step : longInt;
yritauudestaan : BOOLEAN;
px, py : shortInt;
key : char;
lopussa : BOOLEAN;
gd,gm: integer;
dx, dy : shortInt;
lev,kork : shortInt;
error : SmallInt;
ok, lopeta : BOOLEAN;
TheLine : String;
PROCEDURE arvolabyrintti;
VAR i : XTYPE;
j : YTYPE;
ruutu: shortint;
BEGIN
FOR i:=1 TO xkoko DO
FOR j:=1 TO ykoko DO
BEGIN
ruutu:= Random(2)+1;
labyrintti[i,j]:= ruutu;
END;
END;
PROCEDURE paastaanulos; {Tarkistetaan satunnaiskävelyllä päästäänkö
edes ulos labyrintista ainakin jotain reittiä. Tämä ei tietenkään ole paras
mahdollinen ja tehokkain tapa, mutta riittävän nopea nykytietokoneille ja
helpoin ohjelmoida.}
VAR x : XTYPE;
y : YTYPE;
askelx, askely: shortint;
BEGIN
yritauudestaan:= FALSE;
{jos arvotussa labyrintissa arvottiin pelaajan kohdalle tiili eli luku 2, niin turha edes yrittää}
if (labyrintti[px,py] = 2) THEN yritauudestaan:= TRUE;
x:= px;
y:= py;
step:=0;
REPEAT
BEGIN
REPEAT
askelx:= -2 + (random(3) + 1); {Joman kumman askeleen täytyy olla nolla.}
askely:= -2 + (random(3) + 1); {Siis vain askeleet pääilmansuuntiin ovat sallittuja.}
step:= step + 1;
UNTIL (((askelx = 0) OR (askely = 0)) AND (labyrintti[x+askelx, y+askely] <> 2) OR (step>maxstep));
if (step > maxstep) THEN yritauudestaan:= true;
x:= x + askelx;
y:= y + askely;
END;
UNTIL (x = 1) or (x = xkoko) or (y = 1) or (y = ykoko) or (yritauudestaan = true);
{ollaan päästy reunaan eli ulos tai luovutaan koko yrityksestä}
END;
PROCEDURE tulostalahialue;
VAR i,j : shortInt;
x1,x2,y1,y2 : shortInt;
a,b : integer;
BEGIN
x1:= px - dx;
x2:= px + (2 * dx+1);
y1:= py - dy;
y2:= py + (2 * dy+1);
FOR j:=y1 TO y2 DO
BEGIN
FOR i:=x1 TO x2 DO
BEGIN
case (labyrintti[i, j]) of
1 : SetFillStyle(SolidFill,white);
2 : SetFillStyle(SolidFill,blue);
3 : SetFillStyle(SolidFill,red);
end;
a:=(i-x1)*lev;
b:=(j-y1)*kork;
if ((i<1) or (i>xkoko) or (j<1) or (j>ykoko)) THEN SetFillStyle(SolidFill,green);
bar(a-lev,b-kork,a,b);
END;
END;
SetColor(black);
TheLine:=Concat('xkoord=',IntToStr(px),' ykoord=',IntToStr(py));
outTextXY(10,10,TheLine);
END;
PROCEDURE alusta;
BEGIN
Randomize;
dx:=8;
dy:=5;
lev:=trunc(800 / (2 * dx + 1));
kork:=trunc(600 / (2 * dy + 1));
initmouse;
gd := D4bit;
gm := m800x600;
initgraph(gd,gm,'');
error := graphResult;
if (error <> grOk) Then
begin
writeln('800x600x16 is not supported!');
halt(1);
end;
px:= trunc(xkoko/2);
py:= trunc(ykoko/2);
yritauudestaan:=true;
repeat
write('Odota, arvon labyrinttia.');
arvolabyrintti;
paastaanulos;
until yritauudestaan = false;
labyrintti[px,py]:=3;
tulostalahialue;
setTextStyle(defaultFont,horizDir,2);
END;
PROCEDURE tv;
BEGIN
IF ((px = 1) or (px = xkoko)) or ((py = 1) or (py = ykoko)) THEN
lopussa:=TRUE;
END;
PROCEDURE huomauta;
BEGIN
Writeln('Ei kannata hakata kupolia muuriin!!');
END;
PROCEDURE tarkistaylos;
BEGIN
if labyrintti[px,py-1]=2 THEN huomauta
ELSE
BEGIN
labyrintti[px,py]:=1;
py:=py-1; ok:=true;
labyrintti[px,py]:=3;
tv;
END;
END;
PROCEDURE tarkistaalas;
BEGIN
if labyrintti[px,py+1]=2 THEN huomauta
ELSE
BEGIN
labyrintti[px,py]:=1;
py:=py+1; ok:=true;
tv;
labyrintti[px,py]:=3;
END;
END;
PROCEDURE tarkistavasen;
BEGIN
if labyrintti[px-1,py]=2 THEN huomauta
ELSE
BEGIN
labyrintti[px,py]:=1;
px:=px-1; ok:=true;
labyrintti[px,py]:=3;
tv;
END;
END;
PROCEDURE tarkistaoikea;
BEGIN
if labyrintti[px+1,py]=2 THEN huomauta
ELSE
BEGIN
labyrintti[px,py]:=1;
px:=px+1; ok:=true;
labyrintti[px,py]:=3;
tv;
END;
END;
begin
alusta;
ok:=false;
lopeta:=false;
lopussa:=false;
repeat
key := readkey;
if key=#0 then begin
REPEAT
key:=readkey;
case key of
#72 : tarkistaylos;
#80 : tarkistaalas;
#75 : tarkistavasen;
#77 : tarkistaoikea;
'a' : lopeta:=true;
end;
UNTIL ok or lopeta or lopussa;
tulostalahialue;
ok:=false; {asetetaan taas falseksi seuraavaa näppäimen painallusta varten}
end;
UNTIL lopeta or lopussa;
IF lopussa THEN WRITELN('LOISTAVAA!! PAASIT LABYRINTISTA ULOS');
end.PetriKeckman kirjoitti:
Bugitiedotuksia otetaan mielellään vastaan.
Ok, huomaan että laitoin teille liian ison haasteen oletusarvoillani. 60x40 labyrintti on liian suuri ja sellaisen bugin huomasin, että kenttö siirtyi ainakin oikealle aina yhden askeleen, kun liikutti pelaajaa oikealle - tällöin ei isokaan Prompti ikkuna riitä, jos labyríntti on iso. EDIT: En ny jaksa enää tänään bugia korjata ja etsiä :(
EDIT: BUGI KORJATTU!! :) :) Sekä .exe:een että tuohon ohjelmalistaukseen! Huolimattomuusvirhe oli bugi nimeltään.
EDIT: Peliä tehty kivemmaksi: se näyttää pelaajan 'gps-koordinaatat', mikä helpottaa ulospääsyä, kun tietää kuinka lähellä reunaa on.
EDIT taas: oli väärä lopetusehdon tarkistus siellä missä tarkisteltiin labyrintin oikeellisuutta! Sille kelpasi vain sellainen, missä oltiin nurkassa! Siksi aiemmissa versioissa jouduttiin testaamaan niin montaa labya. Nyt löytyy nopeasti.
EDIT taas: en ymmärrä miksi tulostuu muureja ylle vaikka pelaaja on päässyt labyssa yläreunaan. En tosiaan ymärrä...Ei näytä kivalta, kun peli ilmoittaa, että 'Onneksi olkoon olet päässyt ulos', vaikka on vielä labyrintissa :(
EDIT: Ohjelma näyttää vaativan 4K näytön, missä Promptin leveys on suurempi. Unohtakaa tämä merkkipohjainen ohjelma!! Teen graafisen käyttöliittymän.
Nyt toimii :) Graafisella käyttöliittymällä. Minun mielestä ihan hyvin toimii. Tämä tästä projektista.
https://petke.info/labyrintti.exe
Ohjelmalistaus korjattu.
Helpotin sekä vaikeutin peliä. Siinä mielessä helpotin, että koko labyrintti näkyy eikä vain osa ja kun aiemmin joka toinen oli muuriruutu, niin nyt vain joka kolmas, mutta! labyrintissa liikkuu nyt sattumanvaraisesti MÖRKÖJÄ. Jos törmäät niihin, niin kuolet. On myös aikarajoitus. Sinulla on vain minuutti aikaa. Jos et siinä ajassa pääse ulos, niin POMMI räjähtää! Vähän tulee klassikkopeli Pacman mieleen? 'Lyökö MÖRKÖ ulos'? Loppuuko aika? Möröt ovat tyhmiä: ne tekevät aukkoja ulos (bugi koodissa :) ).
https://petke.info/labyrintti2.exe
PS: Heilun vähän kuin heinämies täällä Putkassa. Metabolix oli nähnyt vaivaa ja tutkinut mikä mun pasianssin simulointi koodissa oli väärin, niin minä siirryin jo toiseen, mielenkiintoisempaan juttuun. No, onhan tässä aikaa miettiä nyt sitäkin koodia, mutta ensin syömään...
Program labyrinttiuus;
uses winmouse,graph, wincrt,math,sysutils,DateUtils;
CONST xkoko = 100;
ykoko = 80;
maxstep = 999999;
morkoja = 80;
TYPE
XTYPE = 1..xkoko;
YTYPE = 1..ykoko;
koords = RECORD {MÖRKÖJEN KOORDINAATAT!!}
x: 1..xkoko;
y: 1..ykoko;
END;
VAR labyrintti : ARRAY[1..xkoko,1..ykoko] OF smallInt;
MOROT : ARRAY[1..morkoja] OF koords;
step : longInt;
yritauudestaan : BOOLEAN;
px, py : shortInt;
key : char;
lopussa : BOOLEAN;
gd,gm: integer;
dx, dy : shortInt;
lev,kork : shortInt;
error : SmallInt;
ok, lopeta : BOOLEAN;
TheLine : String;
aikalaskuri : LongInt;
xkoord, ykoord, vanhax, vanhay : ShortInt;
a,b : integer;
r : SmallInt;
now1, now2 : TDateTime;
aika : SmallInt;
PROCEDURE arvolabyrintti;
VAR i : XTYPE;
j : YTYPE;
ruutu: shortint;
eikelpaa : BOOLEAN;
BEGIN
FOR i:=1 TO xkoko DO
FOR j:=1 TO ykoko DO
BEGIN
IF Random(3)+1=2 THEN ruutu:=1
ELSE
ruutu:= Random(2)+1;
labyrintti[i,j]:= ruutu;
END;
{Arvotaan myös MORKÖJEN alkukoordinaatat}
FOR i:=1 TO morkoja DO
BEGIN
eikelpaa:=FALSE;
REPEAT
xkoord:=Random(xkoko)+1;
ykoord:=Random(ykoko)+1;
IF (xkoord<(px+15)) AND (xkoord>(px-15)) THEN eikelpaa:=TRUE;
UNTIL (labyrintti[xkoord,ykoord]=1) AND eikelpaa=FALSE;
MOROT[i].x:=xkoord;
MOROT[i].y:=ykoord;
labyrintti[xkoord,ykoord]:=4;
END;
END;
PROCEDURE paastaanulos; {Tarkistetaan satunnaiskävelyllä päästäänkö
edes ulos labyrintista ainakin jotain reittiä. Tämä ei tietenkään ole paras
mahdollinen ja tehokkain tapa, mutta riittävän nopea nykytietokoneille ja
helpoin ohjelmoida.}
VAR x : XTYPE;
y : YTYPE;
askelx, askely: shortint;
BEGIN
yritauudestaan:= FALSE;
{jos arvotussa labyrintissa arvottiin pelaajan kohdalle tiili eli luku 2, niin turha edes yrittää}
if (labyrintti[px,py] = 2) THEN yritauudestaan:= TRUE;
x:= px;
y:= py;
step:=0;
REPEAT
BEGIN
REPEAT
askelx:= -2 + (random(3) + 1); {Jomman kumman askeleen täytyy olla nolla.}
askely:= -2 + (random(3) + 1); {Siis vain askeleet pääilmansuuntiin ovat sallittuja.}
step:= step + 1;
UNTIL (((askelx = 0) OR (askely = 0)) AND (labyrintti[x+askelx, y+askely] <> 2) OR (step>maxstep));
if (step > maxstep) THEN yritauudestaan:= true;
x:= x + askelx;
y:= y + askely;
END;
UNTIL ((x<2) or (x>xkoko) or (y<2) or (y>ykoko)) or (yritauudestaan = true);
{ollaan päästy reunaan eli ulos tai luovutaan koko yrityksestä}
END;
PROCEDURE tulostalahialue;
VAR i,j : shortInt;
x1,x2,y1,y2 : shortInt;
BEGIN
x1:= 0;
x2:= xkoko+1;
y1:= 0;
y2:= ykoko+1;
FOR j:=(y1+1) TO y2 DO
BEGIN
FOR i:=(x1+1) TO x2 DO
BEGIN
case (labyrintti[i, j]) of
1 : SetFillStyle(SolidFill,white);
2 : SetFillStyle(SolidFill,blue);
3 : SetFillStyle(SolidFill,red);
4 : SetFillStyle(SolidFill,yellow);
end;
a:=(i-x1+1)*lev;
b:=(j-y1+1)*kork;
if ((i<2) or (i>xkoko) or (j<2) or (j>ykoko)) THEN SetFillStyle(SolidFill,green);
bar(a-lev,b-kork,a,b);
END;
END;
END;
PROCEDURE piirraruutu(x1,y1,x2,y2,vari:ShortInt); {piirtää joko mörön tai pelaajan kohtaan
x1,y1 ja valkoistaa edellisen ruudun x2,y2}
BEGIN
case (vari) of
3 : SetFillStyle(SolidFill,red);
4 : SetFillStyle(SolidFill,yellow);
end;
a:=x1*lev;
b:=y1*kork;
bar(a,b,a+lev,b+kork);
SetFillStyle(SolidFill,white);
a:=x2*lev;
b:=y2*kork;
bar(a,b,a+lev,b+kork);
END;
PROCEDURE alusta;
BEGIN
Randomize;
dx:=trunc(xkoko/2);
dy:=trunc(ykoko/2);
initmouse;
gd := detect;
initgraph(gd,gm,'');
error := graphResult;
if (error <> grOk) Then
begin
writeln('grapich state is not supported!');
halt(1);
end;
lev:=trunc(GetMaxX / (2 * dx + 1));
kork:=trunc(GetMaxY / (2 * dy + 1));
px:= trunc(xkoko/2);
py:= trunc(ykoko/2);
yritauudestaan:=true;
repeat
write('Odota, arvon labyrinttia.');
arvolabyrintti;
paastaanulos;
until yritauudestaan = false;
labyrintti[px,py]:=3;
tulostalahialue;
setTextStyle(defaultFont,horizDir,2);
END;
PROCEDURE tv;
BEGIN
if ((px<2) or (px>xkoko) or (py<2) or (py>ykoko)) THEN
lopussa:=TRUE;
END;
PROCEDURE huomauta;
BEGIN
Writeln('Ei kannata hakata kupolia muuriin!!');
END;
PROCEDURE RAJAHDYS;
VAR pxword,pyword : word;
BEGIN
Writeln('RAJAHDYS!!!!!!!!!!!!!!!!!!!!!');
pxword:=trunc((px/xkoko)*GetMAxX);
pyword:=trunc((py/ykoko)*GetMaxY);
FOR r:=1 TO trunc(GetMaxY/10) DO
BEGIN
SetFillStyle(SolidFill,Random(GetMAxColor));
FillEllipse(pxword,pyword,30*r,30*r);
END;
halt(2);
END;
PROCEDURE tarkistasuunta(dx,dy:ShortInt); {dx on joko -1 tai 1 samoin kuin dy}
BEGIN
IF labyrintti[px+dx,py+dy]=4 THEN RAJAHDYS;
if labyrintti[px+dx,py+dy]=2 THEN huomauta
ELSE
BEGIN
vanhax:=px; vanhay:=py;
labyrintti[px,py]:=1;
px:=px+dx; py:=py+dy;
ok:=true;
tv;
labyrintti[px,py]:=3;
piirraruutu(px,py,vanhax,vanhay,3);
IF labyrintti[px,py]=4 THEN RAJAHDYS;
END;
END;
PROCEDURE siirramorkoja;
VAR i, vanhax, vanhay, askelx, askely, yrityksia : ShortInt;
BEGIN
FOR i:=1 TO morkoja DO
BEGIN
vanhax:=MOROT[i].x;
vanhay:=MOROT[i].y;
yrityksia:=0;
REPEAT
REPEAT
yrityksia:=yrityksia+1;
askelx:=-2+(random(3)+1);
askely:=-2+(random(3)+1);
UNTIL ((askelx=0) XOR (askely=0));
UNTIL (labyrintti[vanhax+askelx,vanhay+askely]=1) OR (yrityksia>20) OR (labyrintti[vanhax+askelx,vanhay+askely]=3);
IF labyrintti[vanhax+askelx,vanhay+askely]=3 THEN RAJAHDYS;
IF (yrityksia<20) AND (labyrintti[vanhax+askelx,vanhay+askely]=1) THEN
BEGIN
MOROT[i].x:=vanhax+askelx; MOROT[i].y:=vanhay+askely;
piirraruutu(vanhax+askelx,vanhay+askely,vanhax,vanhay,4);
IF labyrintti[MOROT[i].x,MOROT[i].y]=3 THEN RAJAHDYS;
END;
IF labyrintti[MOROT[i].x,MOROT[i].y]=3 THEN RAJAHDYS;
END;
END;
begin
alusta;
ok:=false;
lopeta:=false;
lopussa:=false;
now1:=Now;
repeat
REPEAT
aikalaskuri:=0;
siirramorkoja;
REPEAT
aikalaskuri:=aikalaskuri+1;
{Tehotonta! Senkun lasketaan kymmeneen miljoonaan ja kasvatetaan aikalaskuria,
mutta mihinkäs tässä kiire näppäinpainallusta odotellessa ja mörköjä liikutellessa}
UNTIL (aikalaskuri=20000000) OR KeyPressed;
now2:=Now;
aika:=(trunc(((100000*(now2-now1)))));
Writeln('Aikaa jaljella vain',60-aika,' sekuntia!!');
IF aika>60 THEN RAJAHDYS;
aikalaskuri:=0;
siirramorkoja;
IF KeyPressed THEN
BEGIN
key:=readkey;
case key of
#72 : tarkistasuunta(0,-1);
#80 : tarkistasuunta(0,1);
#75 : tarkistasuunta(-1,0);
#77 : tarkistasuunta(1,0);
'a' : lopeta:=true;
end;
END;
UNTIL ok or lopeta or lopussa;
ok:=false; {asetetaan taas falseksi seuraavaa näppäimen painallusta varten}
UNTIL lopeta or lopussa;
IF lopussa THEN WRITELN('LOISTAVAA!! PAASIT LABYRINTISTA ULOS');
end.Kivan retro! Itse joskus meinasin tehdä pelin missä liikuttaisiin luolastossa, mutta en sitten jaksanut ikinä tehdä valmiiksi asti.
Luolaston piirtäminen onnistuu kivasti omalla "tilemap" kirjastolla, mikä taipuu ruutupohjaisiin peleihin ja tasohyppelyihin.
Oma kokeiluni näytti aikanaan tältä.
Mutta "tilemap" kirjastollani voi kohtuullisen helposti myös toteuttaa tämän kaltaisia skrollaavia tasohyppelyitä.
jalski kirjoitti:
Kivan retro! Itse joskus meinasin tehdä pelin missä liikuttaisiin luolastossa, mutta en sitten jaksanut ikinä tehdä valmiiksi asti.
Joo. On joskus vaikeaa ja vaivalloista työstää ideoitaan valmiiksi ohjelmiksi. Jäävät minullakin yleensä puolitiehen.
jalski kirjoitti:
Oma kokeiluni näytti aikanaan tältä.
Näyttääpä hienolta! En ole tottunut kirjastoja käyttämään, mutta taidanpa opetella tuollaisen 'tilemap' kirjaston käytön. Kysyn sitten sinulta neuvoa jos en osaa. Pikkasen jo Googlailin. Hankalalta vaikutti. Jos jaksat ja vaivaudut, niin voisit nyt jo vähän avittaa, että kuinka tuollainen kirjasto otetaan käyttöön?
Teen sitten labyrinttipelistä näyttävämmän näköisen.
PetriKeckman kirjoitti:
Jos jaksat ja vaivaudut, niin voisit nyt jo vähän avittaa, että kuinka tuollainen kirjasto otetaan käyttöön?
Tuo kirjasto on siis omaa tuotantoani 8th ohjelmointikielelle ja käytännössä koostuu muutamasta moduulista: viewport, map ja tilemap.
Näiden avulla kartta pystytään piirtämään mihin kohtaan ruutua tahansa ja se osa kartasta mikä halutaan piirtää. Mukana on myös perustoiminnallisuus kartta editorin toteuttamista varten, kuten hiirituki, karttaruudukon piirtäminen ja halutun ruudun selvitys. Vanhan liiton tasohyppelyn toteutusta varten on mahdollisuus selvittää mikä pikselin väri on kartalla tietyssä pisteessä. Näin voidaan käyttää erillistä törmäyskarttaa kertomaan onko kyseinen kohta esimerkiksi maata tai taso mihin voi alapuolen läpi hypätä.
Jos et tarvitse skrollaavaa karttaa, niin et tarvitse kirjastoa, selviät pienemmällä toiminnallisuudella ja voit yksinkertaisesti piirtää kartan taulukosta silmukassa ruudulle.
Aihe on jo aika vanha, joten et voi enää vastata siihen.
