home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug147.arc / ADVENTUR.LBR / ADV1UNT3.PZS / ADV1UNT3.PAS
Pascal/Delphi Source File  |  1979-12-31  |  7KB  |  387 lines
  1. (* text module advunit4.txt *)
  2.  
  3. (*************************************************************************)
  4. (*   procedure pmaze                                                                    *)
  5. (*************************************************************************)
  6. PROCEDURE pmaze;
  7. TYPE
  8.  
  9.    mazerooms = (m1,m2,m3,m4,m5,m6,m7,m8,m9,
  10.                 m10,m11,m12,m13,m14,m15,m16,m17,m18,m19);
  11. VAR
  12.  
  13.    mazeloc:     mazerooms;
  14.    bitset:      ARRAY[directions] OF BOOLEAN;
  15.  
  16.    FUNCTION bittest (v: INTEGER; dir: directions): BOOLEAN;
  17.  
  18.    BEGIN
  19.       IF ((v DIV twopow[dir]) MOD 2) = 1 THEN
  20.          bittest := true
  21.       ELSE
  22.          bittest := false;
  23.       (* endif *)
  24.    END; (* function bittest *)
  25.  
  26.    PROCEDURE describe( wh: INTEGER);
  27.  
  28.    VAR
  29.       dir:     directions;
  30.  
  31.    BEGIN
  32.  
  33.       writeln ('You are in a maze of featureless');
  34.       writeln ('passages. There are exits visible');
  35.       writeln ('in the following directions:');
  36.  
  37.       if bittest (wh,n)  THEN write ('n ');
  38.       if bittest (wh,s)  THEN write ('s ');
  39.       if bittest (wh,e)  THEN write ('e ');
  40.       if bittest (wh,w)  THEN write ('w ');
  41.       if bittest (wh,u)  THEN write ('u ');
  42.       if bittest (wh,d)  THEN write ('d ');
  43.  
  44.       writeln;
  45.    END; (* procedure describe *)
  46.  
  47. PROCEDURE sameplace;
  48.  
  49. BEGIN
  50.  
  51.    writeln ('You have crawled around some twisted');
  52.    writeln ('tunnels and wound up where you began.');
  53.  
  54. END; (* proc sameplace *)
  55.  
  56. PROCEDURE treasure;
  57.  
  58. BEGIN
  59.    IF NOT carrying THEN
  60.    BEGIN
  61.       IF readmsg THEN
  62.       BEGIN
  63.          writeln ('The treasure is here!!');
  64.          writeln ('Do you want to take it now?');
  65.  
  66.          readln (command);
  67.          command := Upcase(command);
  68.  
  69.          IF (command = 'Y') OR (command = 'YES') THEN
  70.             carrying := true;
  71.  
  72.       END
  73.       ELSE
  74.       BEGIN
  75.          writeln ('The light is extremely dim here.');
  76.          writeln ('You better get out or risk falling');
  77.          writeln ('into a pit.');
  78.       END; (* if readmsg *)
  79.    END; (* if not carrying *)
  80. END; (* proc treasure *)
  81.  
  82. PROCEDURE pm1;
  83. BEGIN
  84.    writeln ('You are in a maze of featureless passages.');
  85.    writeln ('From here you can go south, east, west or up.');
  86.  
  87.    CASE whichway OF
  88.  
  89.       s:    location := ladder;
  90.       e:    mazeloc  := m2;
  91.       w:    mazeloc  := m4;
  92.       u:    location := steam;
  93.       n,d:  noway;
  94.  
  95.     END; (* case *)
  96. END; (* proc pm1 *)
  97.  
  98.  
  99. PROCEDURE pm2;
  100. BEGIN
  101.    describe (nw);
  102.  
  103.    CASE whichway OF
  104.  
  105.       n:        mazeloc  := m1;
  106.       w:        sameplace;
  107.       e,s,u,d:  noway;
  108.  
  109.     END; (* case *)
  110. END; (* proc pm2*)
  111.  
  112. PROCEDURE pm3;
  113. BEGIN
  114.    describe (ne);
  115.  
  116.    CASE whichway OF
  117.  
  118.       n:        mazeloc  := m1;
  119.       e:        sameplace;
  120.       w,s,u,d:  noway;
  121.  
  122.     END; (* case *)
  123. END; (* proc pm3*)
  124.  
  125. PROCEDURE pm4;
  126. BEGIN
  127.    describe (sew);
  128.  
  129.    CASE whichway OF
  130.  
  131.       s:        mazeloc  := m7;
  132.       e:        mazeloc  := m3;
  133.       w:        mazeloc  := m5;
  134.       n,u,d:  noway;
  135.  
  136.     END; (* case *)
  137. END; (* proc pm4*)
  138.  
  139. PROCEDURE pm5;
  140. BEGIN
  141.    describe (nonly);
  142.  
  143.    CASE whichway OF
  144.  
  145.       n:          mazeloc  := m1;
  146.       s,e,w,u,d:  noway;
  147.  
  148.     END; (* case *)
  149. END; (* proc pm5*)
  150.  
  151. PROCEDURE pm6;
  152. BEGIN
  153.    describe (ne);
  154.  
  155.    CASE whichway OF
  156.  
  157.       n:          mazeloc  := m4;
  158.       e:          sameplace;
  159.       s,w,u,d:    noway;
  160.  
  161.     END; (* case *)
  162. END; (* proc pm6*)
  163.  
  164. PROCEDURE pm7;
  165. BEGIN
  166.    describe (nsew);
  167.  
  168.    CASE whichway OF
  169.  
  170.       n:          mazeloc  := m5;
  171.       s:          mazeloc  := m9;
  172.       e:          mazeloc  := m6;
  173.       w:          mazeloc  := m8;
  174.       u,d:    noway;
  175.  
  176.     END; (* case *)
  177. END; (* proc pm7*)
  178.  
  179.  
  180. PROCEDURE pm8;
  181. BEGIN
  182.    describe (nw);
  183.  
  184.    CASE whichway OF
  185.  
  186.       n:          mazeloc  := m5;
  187.       w:          sameplace;
  188.       e,s,u,d:    noway;
  189.  
  190.     END; (* case *)
  191. END; (* proc pm8*)
  192.  
  193.  
  194. PROCEDURE pm9;
  195. BEGIN
  196.    describe (sw);
  197.  
  198.    CASE whichway OF
  199.  
  200.       s:          mazeloc  := m11;
  201.       w:          mazeloc  := m10;
  202.       n,e,u,d:    noway;
  203.  
  204.     END; (* case *)
  205. END; (* proc pm9*)
  206.  
  207.  
  208. PROCEDURE pm10;
  209. BEGIN
  210.    describe (ns);
  211.  
  212.    CASE whichway OF
  213.  
  214.       s:          sameplace;
  215.       n:          mazeloc  := m8;
  216.       e,w,u,d:    noway;
  217.  
  218.     END; (* case *)
  219. END; (* proc pm10*)
  220.  
  221.  
  222. PROCEDURE pm11;
  223. BEGIN
  224.    describe (newud);
  225.  
  226.    CASE whichway OF
  227.  
  228.       n:          mazeloc  := m9;
  229.       e:          mazeloc  := m6;
  230.       w:          mazeloc  := m10;
  231.       u:          mazeloc  := m1;
  232.       d:          mazeloc  := m12;
  233.  
  234.       s:          noway;
  235.  
  236.     END; (* case *)
  237. END; (* proc pm11*)
  238.  
  239.  
  240. PROCEDURE pm12;
  241. BEGIN
  242.    describe (dn);
  243.  
  244.    CASE whichway OF
  245.  
  246.       n:          mazeloc  := m13;
  247.       d:          mazeloc  := m16;
  248.  
  249.       e,s,w,u:    noway;
  250.  
  251.     END; (* case *)
  252. END; (* proc pm12*)
  253.  
  254. PROCEDURE pm13;
  255. BEGIN
  256.    describe (dn);
  257.  
  258.    CASE whichway OF
  259.  
  260.       n:          mazeloc  := m14;
  261.       d:          mazeloc  := m17;
  262.  
  263.       e,s,w,u:    noway;
  264.  
  265.     END; (* case *)
  266. END; (* proc pm13*)
  267.  
  268. PROCEDURE pm14;
  269. BEGIN
  270.    describe (dn);
  271.  
  272.    CASE whichway OF
  273.  
  274.       n:          mazeloc  := m15;
  275.       d:          mazeloc  := m18;
  276.  
  277.       e,s,w,u:    noway;
  278.  
  279.     END; (* case *)
  280. END; (* proc pm14*)
  281.  
  282. PROCEDURE pm15;
  283. BEGIN
  284.    describe (ud);
  285.  
  286.    CASE whichway OF
  287.  
  288.       u:          mazeloc  := m1;
  289.       d:          mazeloc  := m19;
  290.  
  291.       n,e,s,w:    noway;
  292.  
  293.     END; (* case *)
  294. END; (* proc pm15*)
  295.  
  296. PROCEDURE pm16;
  297. BEGIN
  298.    describe (ns);
  299.  
  300.    CASE whichway OF
  301.  
  302.       n:          mazeloc  := m17;
  303.       s:          sameplace;
  304.  
  305.       e,w,u,d:    noway;
  306.  
  307.     END; (* case *)
  308. END; (* proc pm16*)
  309.  
  310.  
  311. PROCEDURE pm17;
  312. BEGIN
  313.    describe (ns);
  314.  
  315.    CASE whichway OF
  316.  
  317.       n:          mazeloc  := m18;
  318.       s:          mazeloc  := m16;
  319.  
  320.       e,w,u,d:    noway;
  321.  
  322.     END; (* case *)
  323. END; (* proc pm17*)
  324.  
  325. PROCEDURE pm18;
  326. BEGIN
  327.    describe (ns);
  328.  
  329.    CASE whichway OF
  330.  
  331.       n:          mazeloc  := m19;
  332.       s:          mazeloc  := m17;
  333.  
  334.       e,w,u,d:    noway;
  335.  
  336.     END; (* case *)
  337. END; (* proc pm18*)
  338.  
  339. PROCEDURE pm19;
  340. BEGIN
  341.    describe (su);
  342.    treasure;
  343.  
  344.    CASE whichway OF
  345.  
  346.       s:          mazeloc  := m18;
  347.       u:          mazeloc  := m15;
  348.  
  349.       n,e,w,d:    noway;
  350.  
  351.     END; (* case *)
  352. END; (* proc pm19*)
  353.  
  354.  
  355. BEGIN (* proc pmaze *)
  356.  
  357.    mazeloc := m1;
  358.    REPEAT
  359.  
  360.       CASE mazeloc OF
  361.  
  362.          m1:      pm1;
  363.          m2:      pm2;
  364.          m3:      pm3;
  365.          m4:      pm4;
  366.          m5:      pm5;
  367.          m6:      pm6;
  368.          m7:      pm7;
  369.          m8:      pm8;
  370.          m9:      pm9;
  371.          m10:     pm10;
  372.          m11:     pm11;
  373.          m12:     pm12;
  374.          m13:     pm13;
  375.          m14:     pm14;
  376.          m15:     pm15;
  377.          m16:     pm16;
  378.          m17:     pm17;
  379.          m18:     pm18;
  380.          m19:     pm19;
  381.  
  382.       END; (* case *)
  383.  
  384.    UNTIL location <> maze;
  385.  
  386. END; (* proc pmaze *)
  387.