fork(1) download
copy 
  1. program Przygodowka_szablon;
  2. uses crt;
  3.  
  4. const
  5.  
  6.  MAXITEMS=5;
  7.  
  8.  map :array [1..16,1..12] of byte =
  9.  ((1,1,1,1,1,1,1,1,1,1,1,1),
  10.   (1,0,0,0,1,0,1,1,0,0,1,1),
  11.   (1,0,1,0,0,0,0,0,1,0,1,1),
  12.   (1,0,1,0,1,0,1,1,0,0,1,1),
  13.   (1,1,1,1,1,1,1,1,1,1,1,1),
  14.   (1,0,0,1,1,0,0,1,0,0,0,1),
  15.   (1,0,1,0,0,1,0,1,0,0,1,1),
  16.   (1,0,1,0,0,1,0,1,0,0,0,1),
  17.   (1,1,1,0,0,1,0,1,0,0,1,1),
  18.   (1,0,0,1,1,0,0,0,0,0,0,1),
  19.   (1,0,0,1,1,0,0,1,0,0,0,1),
  20.   (1,0,0,0,0,0,0,1,0,0,1,1),
  21.   (1,0,0,1,1,0,0,1,0,0,1,1),
  22.   (1,0,0,1,1,0,0,1,0,0,0,1),
  23.   (1,0,0,1,0,0,0,1,0,0,0,1),
  24.   (1,1,1,1,1,1,1,1,1,1,1,1));
  25.  
  26.   places_ :array[1..6] of string =
  27.   ('Jestes na lesnej sciezce.',
  28.    'Mozesz isc na :',
  29.    'Przed toba jaskinia.',
  30.    'Przed toba wyjscie z jaskini.',
  31.    'Jestes w ciemnej jaskini.',
  32.    'Jestes w podziemnym labiryncie.');
  33.  
  34.  
  35.   items :array [1..MAXITEMS] of string = ('KAMIEN','SZTYLET','PATYK','LISC','SZNUREK');
  36.  
  37.  
  38. var
  39.     X :byte; Y:byte; JASKINIA: byte; MAPVISIBLE :byte; INCAVE :byte; ITEMHERE :byte;
  40.     ITEMINLOC :array [1..MAXITEMS] of byte;
  41.     LOCITEMX  :array[1..MAXITEMS] of byte;
  42.     LOCITEMY  :array[1..MAXITEMS] of byte; 
  43.     PLACE_    :string[200]; C_ :string[15];
  44.  
  45.     VERB_ :string; INV_ :string[15]; INV :array[1..MAXITEMS] of byte; LOCX :byte; LOCY :byte; TMP_ :string;
  46.     LOCN, LOCS, LOCE, LOCW, OLDX, OLDY :byte;
  47.     N_, S_, E_, W_ :string[10];
  48.  
  49.     noun :string[15];
  50.     cmd  :string[50];
  51.     i :byte;
  52.  
  53.  
  54.  
  55. procedure look;
  56. begin
  57. {6452 IF LOCY>5 THEN RESTORE 6005:READ PLACE$
  58. 6453 PRINT :PRINT PLACE$;:PRINT " ";:ITEMHERE=0
  59. 6454 FOR I=1 TO MAXITEMS:IF ITEMINLOC(I)=1 AND LOCITEMX(I)=LOCX AND LOCITEMY(I)=LOCY THEN ITEMHERE=1
  60. 6455 NEXT I:IF ITEMHERE=1 THEN PRINT "Tu lezy ";
  61. 6456 RESTORE 6504:FOR I=1 TO MAXITEMS:READ VERB$
  62. 6457 IF ITEMINLOC(I)=1 AND LOCITEMX(I)=LOCX AND LOCITEMY(I)=LOCY THEN PRINT VERB$;:PRINT " ";
  63. 6458 NEXT I:PRINT :PRINT "NACISNIJ <RETURN>";:INPUT VERB$:PRINT 
  64. 6459 ITEMHERE=0:RETURN 
  65. }
  66.  
  67. end;
  68.  
  69.  
  70. procedure open;
  71. begin
  72. {
  73. 204 IF (JASKINIA=1) AND (LOCX=8) AND (LOCY=3) THEN PRINT "Jaskinia jest otwarta.":JASKINIA=0
  74. 205 IF JASKINIA=1 THEN PRINT "Nie mozesz tu nic otworzyc.":PRINT "Nacisnij <RETURN>":INPUT VERB$
  75. 207 RETURN 
  76. }
  77. end;
  78.  
  79.  
  80. procedure show_inv;
  81. begin
  82. {
  83. 1000 PRINT :PRINT "Posiadasz: ":RESTORE 6504:FOR I=1 TO MAXITEMS:READ INV$
  84. 1001 IF INV(I)>0 THEN PRINT INV$;:INPUT VERB$
  85. 1002 NEXT I:RETURN 
  86. }
  87. end;
  88.  
  89.  
  90. procedure show_map;
  91. begin
  92. {
  93. 198 RESTORE 6530:X=5:IF LOCY>5 THEN X=16
  94. 200 FOR I=1 TO X:FOR J=1 TO 12:READ C:COLOR C:FOR X=1 TO 4:PLOT J*4,I*4+X:DRAWTO (J+4)*4,I*4+X
  95. 201 PLOT J*4,I*4+4:DRAWTO J*4+4,I*4+4:NEXT X:NEXT J:NEXT I
  96. 202 COLOR 2:PLOT LOCX*4+2,LOCY*4+2:OLDX=LOCX:OLDY=Y:MAPVISIBLE=1
  97. 203 RETURN 
  98. }
  99. end;
  100.  
  101.  
  102.  
  103. function end_check :boolean;
  104. begin
  105.  
  106. end_check:=false;
  107.  
  108. IF (INV[3]=1) AND (LOCITEMX[1]=10) AND (LOCITEMY[1]=4) AND (INV[5]=1) THEN end_check:=true;
  109.  
  110. end;
  111.  
  112.  
  113. procedure get;
  114. begin
  115. {
  116. 6440 PRINT "Co bierzesz ";:INPUT TMP$
  117. 6441 RESTORE 6504:FOR I=1 TO MAXITEMS:READ VERB$
  118. 6442 IF LOCX=LOCITEMX(I) AND LOCY=LOCITEMY(I) AND VERB$=TMP$ THEN INV(I)=1:LOCITEMX(I)=-1:LOCITEMY(I)=0
  119. 6443 IF LOCITEMX(I)=-1 THEN ITEMINLOC(I)=ITEMINLOC(I)-1:ITEMHERE=3:LOCITEMX(I)=0
  120. 6444 NEXT I:IF ITEMHERE=3 THEN PRINT :PRINT "Wziales ";:PRINT TMP$
  121. 6445 ITEMHERE=0:RETURN 
  122. }
  123. end;
  124.  
  125.  
  126. procedure drop;
  127. begin
  128.  
  129. {
  130. 6446 PRINT "Co chcesz zostawic ";:INPUT TMP$:RESTORE 6504:FOR I=1 TO MAXITEMS:READ VERB$
  131. 6447 IF INV(I)=1 AND VERB$=TMP$ THEN GOTO 6449
  132. 6448 NEXT I:RETURN 
  133. 6449 INV(I)=0:LOCITEMX(I)=LOCX:LOCITEMY(I)=LOCY:ITEMINLOC(I)=ITEMINLOC(I)+1
  134. 6450 PRINT "Zostawiles ";:PRINT TMP$
  135. 6451 RETURN 
  136. }
  137. end;
  138.  
  139.  
  140. procedure enter;
  141. begin
  142.  
  143. {
  144.  
  145. 220 OLDX=LOCX:OLDY=LOCY
  146. 221 IF LOCX=10 AND LOCY=3 AND INCAVE=1 THEN LOCX=8:LOCY=3:PRINT "Wyszedles z jaskini."
  147. 222 IF LOCX=8 AND LOCY=3 AND JASKINIA=0 AND INCAVE=0 THEN LOCX=10:LOCY=3:PRINT "Wszedles do jaskini"
  148. 223 IF (LOCX=10 OR LOCX=8) AND LOCY=3 THEN IF INCAVE=0 THEN INCAVE=1:GOTO 229
  149. 224 IF (LOCX=10 OR LOCX=8) AND LOCY=3 THEN IF INCAVE=1 THEN INCAVE=0
  150. 225 IF LOCX=9 AND LOCY=4 THEN LOCY=6:PRINT "Wszedles do labiryntu.":GOTO 229
  151. 226 IF LOCX=9 AND LOCY=6 THEN LOCY=4:PRINT "Wszedles do jaskini.":GOTO 229
  152. 229 RETURN 
  153. }
  154.  
  155. end;
  156.  
  157.  
  158.  
  159. procedure move_hero;
  160. begin
  161. {
  162. COLOR 0:PLOT OLDX*4+2,OLDY*4+2:COLOR 1:PLOT LOCX*4+2,LOCY*4+2
  163. }
  164. end;
  165.  
  166. begin
  167.  
  168.  
  169. N_:='POLNOC'; S_:='POLUDNIE'; E_:='WSCHOD'; W_:='ZACHOD';
  170. C_:='CO ROBISZ ';
  171. LOCX:=6;LOCY:=3;
  172.  
  173. FOR I:=1 TO MAXITEMS DO INV[I]:=0;
  174.  
  175.  
  176. repeat
  177.  
  178.   VERB_:='KONIEC';
  179.  
  180.   clrscr;
  181.  
  182.   writeln('QUEST ver. beta 04.01'); writeln;
  183.  
  184.   writeln('AUTOR: SMAKU NOV.18.2015'); writeln;
  185.  
  186.   writeln('SLOWNIK: N,S,E,W,LOOK,GET,DROP,INV, MAP,EXIT,OPEN,ENTER'); writeln;
  187.  
  188.   writeln('ZADANIE:'); writeln;
  189.  
  190.   writeln('Zostaw kamien w odpowiednim miejscu jaskini i z patykiem oraz sznurkiem znajdz wyjscie z lasu. Wejscie do labiryntu podziemnego znajduje sie w jaskini.'); writeln;
  191.  
  192.   writeln('GRAJ    - rozpoczecie gry.');
  193.   writeln('KONIEC  - wyjscie z gry.'); writeln;
  194.  
  195.   write('Co robisz ?'); readln(VERB_);
  196.  
  197.   VERB_:='KONIEC';
  198.  
  199. until (VERB_='GRAJ') or (VERB_='KONIEC');
  200.  
  201. IF VERB_='GRAJ' then
  202.  { POCZATEK GRY}
  203.   begin
  204.  
  205. 	FOR I:=1 TO MAXITEMS do ITEMINLOC[I]:=0;
  206.  
  207. 	ITEMINLOC[5]:=1; LOCITEMX[5]:=2; LOCITEMY[5]:=14;
  208.  
  209. 	ITEMINLOC[3]:=1; LOCITEMX[3]:=8; LOCITEMY[3]:=3;ITEMINLOC[1]:=1;LOCITEMX[1]:=9;LOCITEMY[1]:=2;
  210.  
  211. 	LOCN:=1;LOCS:=1;LOCE:=1;LOCW:=1;JASKINIA:=1;MAPVISIBLE:=0;INCAVE:=0;ITEMHERE:=0;
  212.  
  213. 	FOR I:=1 TO MAXITEMS do INV[I]:=0; INV[2]:=1;INV[4]:=1;
  214.  
  215.  
  216.  
  217.  
  218. IF VERB_='EXIT' THEN writeln; writeln('KONIEC GRY. DZIEKUJEMY.'); writeln('Nacisnij RETURN>'); readln(VERB_); VERB_:='KONIEC';
  219.  
  220.  
  221. IF VERB_='E' THEN IF LOCE=0 THEN begin write('Idziesz na wschod. ');OLDX:=LOCX;OLDY:=LOCY;LOCX:=LOCX+1; end;
  222. IF VERB_='N' THEN IF LOCN=0 THEN begin write('Idziesz na polnoc. ');OLDX:=LOCX;OLDY:=LOCY;LOCY:=LOCY-1; end;
  223. IF VERB_='W' THEN IF LOCW=0 THEN begin write('Idziesz na zachod. ');OLDX:=LOCX;OLDY:=LOCY;LOCX:=LOCX-1; end;
  224. IF VERB_='S' THEN IF LOCS=0 THEN begin write('Idziesz na poludnie. '); OLDX:=LOCX; OLDY:=LOCY; LOCY:=LOCY+1; end;
  225.  
  226.  
  227. IF VERB_='MAP' THEN show_map;
  228. IF VERB_='LOOK' THEN look;
  229. IF VERB_='OPEN' THEN open;
  230. IF VERB_='INV' THEN show_inv;
  231.  
  232. ITEMHERE:=0;
  233. FOR I:=1 TO MAXITEMS do IF (ITEMINLOC[I]=1) AND (LOCITEMX[I]=LOCX) AND (LOCITEMY[I]=LOCY) THEN ITEMHERE:=1;
  234.  
  235.  
  236. IF ITEMHERE=1 THEN write('Tu cos jest. '); ITEMHERE:=0;
  237.  
  238. IF VERB_='GET' THEN get;
  239. IF VERB_='DROP' THEN drop;
  240. IF VERB_='ENTER' THEN enter;
  241.  
  242.  
  243. IF (LOCX=2) AND (LOCY=4) AND (end_check) then begin VERB_:='KONIEC'; writeln; writeln('WYSZEDLES Z LASU. GRATULACJE.');writeln('Nacisnij <RETURN>');readln(VERB_); end;
  244.  
  245. IF MAPVISIBLE=1 THEN move_hero;
  246.  
  247.  
  248. {
  249. w basic:
  250.  
  251. itemhere=0 *80-90) usunąc powtórzenie
  252.  
  253. zmienna LOCWY - poprawić
  254.  
  255.  
  256.  
  257. 98 GRAPHICS 6:COLOR 2
  258. 99 RESTORE 6300:READ PLACE$:RESTORE 6504:READ INV$
  259.  
  260. 100 PRINT :PRINT C$;:INPUT VERB$:PRINT :FOR I=1 TO MAXITEMS:IF ITEMINLOC(I)=1 THEN INTEMHERE=1:NEXT I
  261.  
  262. 101 RESTORE 6530+LOCY-2:FOR I=1 TO LOCX:READ LOC:NEXT I:LOCN=LOC
  263. 102 RESTORE 6530+LOCY-1:FOR I=1 TO LOCX-1:READ LOC:NEXT I:LOCW=LOC
  264. 103 READ LOC:READ LOC:LOCE=LOC
  265. 104 RESTORE 6530+LOCY:FOR I=1 TO LOCX:READ LOC:NEXT I:LOCS=LOC
  266.  
  267.  
  268.  
  269. 109 RESTORE 6000:READ PLACE$:IF (LOCX=8) AND (LOCY=3) THEN RESTORE 6002:READ PLACE$
  270. 110 IF LOCX>8 THEN RESTORE 6004:READ PLACE$
  271. 111 IF LOCX=10 AND LOCY=3 THEN RESTORE 6003:READ PLACE$
  272.  
  273.  
  274.  
  275.  
  276. 210 RESTORE 6000:READ PLACE$:IF LOCX=8 AND LOCX=3 THEN RESTORE 6002:READ PLACE$
  277.  
  278.  
  279.  
  280.  
  281. 6501 DATA 20,80,100,50,20,20
  282. 6502 DATA 80,80,130,50,150,50
  283. 6503 DATA 40,4,150,30,150,30
  284.  
  285. }
  286.  
  287.  
  288.  end;
  289.  
  290. 	{ KONIEC }
  291.  
  292. 	writeln('Dziekujemy, do widzenia. Koniec gry. Zapraszamy ponownie.');
  293.  
  294. end.
Success #stdin #stdout 0s 320KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
QUEST ver. beta 04.01

AUTOR: SMAKU NOV.18.2015

SLOWNIK: N,S,E,W,LOOK,GET,DROP,INV, MAP,EXIT,OPEN,ENTER

ZADANIE:

Zostaw kamien w odpowiednim miejscu jaskini i z patykiem oraz sznurkiem znajdz w
yjscie z lasu. Wejscie do labiryntu podziemnego znajduje sie w jaskini.

GRAJ    - rozpoczecie gry.
KONIEC  - wyjscie z gry.

Co robisz ?Dziekujemy, do widzenia. Koniec gry. Zapraszamy ponownie.
https://ideone.com/V7CTKE
language:
Pascal (fpc 3.0.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!