home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / compsrcs / unix / volume06 / pacman.p < prev    next >
Encoding:
Text File  |  1988-09-11  |  47.1 KB  |  1,306 lines
  1. /* Written  8:43 am  Jun 19, 1986 by sources-request@mirror.UUCP in mirror:mod.sources */
  2. /* ---------- "v06i008:  Apollo Pacman-like game (" ---------- */
  3. Submitted by: pyramid!decwrl!imagen!geof (Geof Cooper)
  4. Mod.sources: Volume 6, Issue 8
  5. Archive-name: pacman.p
  6.  
  7. The files in this distribution implement a Pacman-like game on Apollo
  8. nodes.  The programs probably work on SR8, but have only be tested with
  9. SR9.  Aegis calls are used exclusively (this was my program to learn
  10. Apollo Pascal and Aegis).
  11.  
  12. #!/bin/sh
  13. : "This is a shell archive, meaning:                              "
  14. : "1. Remove everything above the #! /bin/sh line.                "
  15. : "2. Save the resulting test in a file.                          "
  16. : "3. Execute the file with /bin/sh (not csh) to create the files:"
  17. : "    README"
  18. : "    board.mod.pas"
  19. : "    fig.mod.pas"
  20. : "    pac.pas"
  21. : "    pac_refresh.pas"
  22. : "This archive created:  Thu Jun 12 11:11:59 PDT 1986 "
  23. echo file: README
  24. sed 's/^X//' >README << 'END-of-README'
  25. X    APOLLO PAC Distribution
  26. X    June, 1986
  27. X
  28. XThe files in this distribution implement a Pacman-like game on apollo
  29. Xnodes.  The programs probably work on SR8, but have only be tested with
  30. XSR9.  Aegis calls are used exclusively (this was my program to learn
  31. Xapollo pascal and aegis).
  32. X
  33. XThe game is run by typing "pac" (one needs a graphics capable window
  34. Xto run it).  The program runs in the window, and stops when the window
  35. Xis obscured.  The screen is correctly redrawn when the window re-emerges,
  36. Xand the game continues normally.
  37. X
  38. XThe game is similar to pacman.  One pac runs around a maze, pursued by
  39. Xpointed objects called "nasties".  The pac scores points by eating the
  40. Xdots in the maze.  When all the dots have been eaten, the screen is
  41. Xrefreshed, an additional nasty appears, and all existing nasties get
  42. Xone pixel-per-tick faster.  The pac's relative to the nasties may be
  43. Xcontrolled.  A faster pac is harder to maneuver.  Also, the tick time
  44. Xmay be modified to speed up or slow down the entire game.
  45. X
  46. XThe pac is steered using the arrow keys.  The keys have the effect of
  47. Xqueuing a turn in the desired direction. The turn happens when the pac
  48. Xis next able to make the turn.  There can only be one turn queued;
  49. Xsubsequent key pushing changes the queued value.  This technique of
  50. Xsteering makes it possible to steer the pac very quickly with a little
  51. Xpractise, since the keys do not have to be pushed at the exact moment
  52. Xthe pac is passing a corridor to effect a turn.
  53. X
  54. XThe sources are written in apollo pascal, and make use of apollo-pascal
  55. Xlanguage extensions and system utilities.  In particular, all graphics
  56. Xis done using GPR, the apollo graphics package.  Some of the keys used
  57. Xare only on Version2 keyboards.  The next-window key is disabled because
  58. XI kept hitting it and losing the game.
  59. X
  60. XThe program is a good example of a simple program that uses GPR.  It is
  61. Xalso a good example of a simple real-time program for aegis.
  62. X
  63. X- Geof Cooper
  64. X  IMAGEN Corporation
  65. END-of-README
  66. echo file: board.mod.pas
  67. sed 's/^X//' >board.mod.pas << 'END-of-board.mod.pas'
  68. XMODULE pacman_board;
  69. X
  70. X{ Written January, 1985 by Geoffrey Cooper                                  }
  71. X{ program for creating a pacman board
  72. X  needed improvements:
  73. X    - ability to save a board for later re-editing
  74. X    - ability to better define size of board - middle button?
  75. X    - ability to set SDOTS as well as dots.}
  76. X{ Copyright (C) 1985, IMAGEN Corporation                                    }
  77. X{ This software may be duplicated in part of in whole so long as [1] this   }
  78. X{ notice is preserved in the copy, and [2] no financial gain is derived     }
  79. X{ from the copy.  Copies of this software other than as restricted above    }
  80. X{ may be made only with the consent of the author.                          }
  81. X
  82. X%include '/sys/ins/base.ins.pas';
  83. X%include '/sys/ins/error.ins.pas';
  84. X%include '/sys/ins/kbd.ins.pas';
  85. X%include '/sys/ins/gpr.ins.pas';
  86. X%include '/sys/ins/vfmt.ins.pas';
  87. X%include '/sys/ins/pgm.ins.pas';
  88. X%include '/sys/ins/pad.ins.pas';
  89. X
  90. XDEFINE 
  91. X    board_$init, board_$reinit,
  92. X    board_$get_num_dots, board_$draw_board, board_$try_pac_position,
  93. X    board_$can_turn, board_$clear_dot, board_$show_score;
  94. X
  95. X%include 'fig.ins.pas';
  96. X%include 'board.ins.pas';
  97. X
  98. XCONST
  99. X    board_width_x =    31;
  100. X    board_width_y =    34;
  101. X
  102. X    halfguage = guage div 2;
  103. X
  104. X    score_x = guage;
  105. X    score_y = (board_width_y+1) * guage;
  106. X
  107. X    pac_x = guage;
  108. X    pac_y = score_y + 16;
  109. X
  110. XTYPE
  111. X    board_$config = array [0..board_width_x-1, 0..board_width_y-1]
  112. X                          of board_$elt;
  113. X
  114. XVAR
  115. X    wall_bm     : gpr_$bitmap_desc_t;
  116. X    dot_bm      : gpr_$bitmap_desc_t;
  117. X    sdot_bm     : gpr_$bitmap_desc_t;
  118. X
  119. X    board_numdcor: integer;
  120. X    board_numscor: integer;
  121. X
  122. X    score       : integer;
  123. X    numpacs     : integer;
  124. X    w           : gpr_$window_t;
  125. X    status      : status_$t;
  126. X
  127. X    board       : board_$config;
  128. X    board_init  : board_$config := [
  129. X    [ wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall],
  130. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall],
  131. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, dcor, wall],
  132. X    [ wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, wall, dcor, wall],
  133. X    [ wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, wall, wall, wall, wall, wall, dcor, dcor, wall, wall, dcor, wall],
  134. X    [ wall, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, wall, dcor, wall],
  135. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall],
  136. X    [ wall, dcor, wall, dcor, scor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, wall, dcor, wall],
  137. X    [ wall, dcor, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, dcor, wall],
  138. X    [ wall, dcor, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, dcor, wall],
  139. X    [ wall, dcor, wall, dcor, scor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, wall, dcor, wall],
  140. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, dcor, wall],
  141. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall],
  142. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall],
  143. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall],
  144. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, dcor, wall],
  145. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, scor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall],
  146. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  147. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  148. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, dcor, wall, wall, wall, dcor, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  149. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, dcor, dcor, wall, wall, dcor, wall, dcor, wall, dcor, dcor, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  150. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, wall, wall, wall, wall, dcor, wall, dcor, wall, dcor, wall, dcor, dcor, dcor, dcor, dcor, wall, wall, wall, wall, dcor, wall],
  151. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, dcor, wall, wall, dcor, wall, wall, wall, wall, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  152. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, dcor, wall, wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, dcor, wall, dcor, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  153. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  154. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, dcor, wall, dcor, wall, dcor, wall, dcor, dcor, dcor, dcor, dcor, wall, wall, wall, wall, dcor, wall],
  155. X    [ wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, dcor, wall, dcor, wall, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  156. X    [ wall, dcor, wall, wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall, dcor, wall, dcor, dcor, dcor, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  157. X    [ wall, dcor, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, dcor, wall, dcor, wall, wall, wall, wall, wall, dcor, wall, wall, wall, wall, dcor, wall],
  158. X    [ wall, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, dcor, wall],
  159. X    [ wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall, wall]
  160. X    ];
  161. X
  162. X
  163. XPROCEDURE board_$fail(r: integer);
  164. Xbegin
  165. X    gpr_$terminate(false, status);
  166. X    writeln('board_$fail(', r:0, ')');
  167. X    pgm_$exit;
  168. Xend;
  169. X
  170. XPROCEDURE board_$print_integer(n: integer; IN ctl: string; x, y: integer);
  171. XVAR
  172. X    text: string;
  173. X    nlong: integer32;
  174. X    textlen: integer;
  175. X    status: status_$t;
  176. X    dummy: integer32;
  177. XBEGIN
  178. X    nlong := n;
  179. X    vfmt_$encode2(ctl, text, 80, textlen, nlong, dummy);
  180. X    gpr_$move(x, y, status);
  181. X    gpr_$text(text, textlen, status);
  182. XEND;
  183. X
  184. XPROCEDURE board_$draw_board;
  185. XVAR
  186. X    x, y: INTEGER;
  187. X    bm: gpr_$bitmap_desc_t;
  188. X    pos: gpr_$position_t;
  189. XBEGIN
  190. X    gpr_$set_raster_op(0, 3, status);
  191. X    gpr_$clear(0, status);
  192. X    for x := 0 to board_width_x - 1 do
  193. X      begin
  194. X        pos.x_coord := x * guage;
  195. X        for y := 0 to board_width_y -1 do
  196. X          begin
  197. X            if board[x, y] <> ecor then
  198. X              begin
  199. X                case board[x, y] of
  200. X                    wall: bm := wall_bm;
  201. X                    dcor: bm := dot_bm;
  202. X                    scor: bm := sdot_bm
  203. X                end;
  204. X                pos.y_coord := y * guage;
  205. X                gpr_$bit_blt(bm, w, 0, pos, 0, status);
  206. X              end
  207. X          end
  208. X      end;
  209. X
  210. X    board_$print_integer(score, 'score: %5sd%$', score_x, score_y);
  211. X    board_$print_integer(numpacs, 'pacs left: %5sd%$', pac_x, pac_y);
  212. X
  213. X    gpr_$set_raster_op(0, 6, status);
  214. XEND;
  215. X
  216. XPROCEDURE board_$reinit;
  217. XBEGIN
  218. X    score := 0;
  219. X    board := board_init;
  220. X    board_$draw_board;
  221. XEND;
  222. X
  223. XPROCEDURE board_$get_num_dots(* OUT dots, sdots: Integer *);
  224. XBEGIN
  225. X    dots := board_numdcor;
  226. X    sdots := board_numscor;
  227. XEND;
  228. X
  229. XPROCEDURE board_$init(* screen: gpr_$bitmap_desc_t;
  230. X                        screen_size: gpr_$offset_t,
  231. X                        pacs: integer *);
  232. XVAR
  233. X    attr: gpr_$attribute_desc_t;
  234. X    size: gpr_$offset_t;
  235. X    point: gpr_$position_t;
  236. X    x, y: integer;
  237. XBEGIN
  238. X    board_numscor := 0;
  239. X    board_numdcor := 0;
  240. X    for x := 0 to board_width_x-1 do
  241. X        for y := 0 to board_width_y-1 do
  242. X            case board_init[x, y] of
  243. X              scor: board_numscor := board_numscor + 1;
  244. X              dcor: board_numdcor := board_numdcor + 1;
  245. X              wall:;
  246. X              ecor:
  247. X            end;
  248. X    screen_size.x_size := screen_size.x_size div guage;
  249. X    screen_size.y_size := screen_size.y_size div guage;
  250. X    if screen_size.x_size < board_width_x then
  251. X        {board_$fail(1)};
  252. X    if screen_size.y_size < board_width_y then
  253. X        {board_$fail(2)};
  254. X    gpr_$allocate_attribute_block(attr, status);
  255. X    size.x_size := guage;
  256. X    size.y_size := guage;
  257. X    w.window_base.x_coord := 0;
  258. X    w.window_base.y_coord := 0;
  259. X    w.window_size := size;
  260. X    gpr_$allocate_bitmap(size, 0, attr, wall_bm, status);
  261. X    gpr_$set_bitmap(wall_bm, status);
  262. X    gpr_$clear(1, status);
  263. X
  264. X    gpr_$allocate_bitmap(size, 0, attr, dot_bm, status);
  265. X    gpr_$set_bitmap(dot_bm, status);
  266. X    point.x_coord := halfguage;
  267. X    point.y_coord := halfguage;
  268. X    x := guage div 8;
  269. X    if x = 0 then x := 1;
  270. X    gpr_$circle_filled(point, x, status);
  271. X
  272. X    gpr_$allocate_bitmap(size, 0, attr, sdot_bm, status);
  273. X    gpr_$set_bitmap(sdot_bm, status);
  274. X    gpr_$set_raster_op(0, 6, status);
  275. X    x := guage div 3;
  276. X    if x = 0 then x := 1;
  277. X    gpr_$circle_filled(point, x, status);
  278. X    gpr_$set_fill_value(0, status);
  279. X    x := guage div 5;
  280. X    if x = 0 then x := 1;
  281. X    gpr_$circle_filled(point, x, status);
  282. X    gpr_$set_fill_value(1, status);
  283. X    
  284. X    gpr_$set_bitmap(screen, status);
  285. X
  286. X    score := 0;
  287. X    numpacs := pacs;
  288. X    board := board_init
  289. XEND;
  290. X
  291. XFUNCTION board_$entierGuage(i: integer): integer;
  292. XBEGIN
  293. X    board_$entierGuage := i - (i mod guage);
  294. XEND;
  295. X
  296. X{ modifies a position to avoid hitting a wall }
  297. XPROCEDURE board_$try_pac_position(* IN OUT pos: gpr_$position_t *);
  298. XVAR
  299. X    x, y: integer;
  300. X    x0, y0: integer;
  301. X    test: integer;
  302. X    extrem: integer;
  303. XBEGIN
  304. X    if pos.x_coord < 0 then pos.x_coord := 0;
  305. X    if pos.y_coord < 0 then pos.y_coord := 0;
  306. X    if pos.x_coord > ((board_width_x-1)*guage) then
  307. X        pos.x_coord := ((board_width_x-1)*guage);
  308. X    if pos.y_coord > ((board_width_y-1)*guage) then
  309. X        pos.y_coord := ((board_width_y-1)*guage);
  310. X
  311. X    x := pos.x_coord div guage;
  312. X    y := pos.y_coord div guage;
  313. X
  314. X    { find constraints in each direction }
  315. X    if board[x, y] = wall then
  316. X      begin
  317. X        if x < (board_width_x-1) and then board[x+1, y] <> wall then
  318. X            begin
  319. X                x := x + 1;
  320. X                pos.x_coord := x*guage;
  321. X            end
  322. X        else if y < (board_width_y-1) and then board[x, y+1] <> wall then
  323. X            begin
  324. X                y := y + 1;
  325. X                pos.y_coord := y*guage;
  326. X            end
  327. X      end;
  328. X
  329. X    extrem := (pos.x_coord + (guage-1)) div guage;
  330. X    if extrem >= board_width_x then extrem := board_width_x-1;
  331. X    if extrem > x AND THEN board[extrem, y] = wall then
  332. X            pos.x_coord := x*guage;
  333. X
  334. X    extrem := (pos.y_coord + (guage-1)) div guage;
  335. X    if extrem >= board_width_y then extrem := board_width_y-1;
  336. X    if extrem > y AND THEN board[x, extrem] = wall then
  337. X            pos.y_coord := y*guage;
  338. XEND;
  339. X
  340. X{ called to make a figure execute a saved turn }
  341. XPROCEDURE board_$can_turn(* IN OUT pos: gpr_$position_t;
  342. X                            IN     new_dir: board_$direction;
  343. X                            OUT    turn: boolean *);
  344. XVAR
  345. X    elt: board_$elt;
  346. X    x_inc, y_inc: integer;
  347. X    x, y: integer;
  348. X    spos: gpr_$position_t;
  349. XBEGIN
  350. X    spos.x_coord := (pos.x_coord+halfguage) div guage;
  351. X    spos.y_coord := (pos.y_coord+halfguage) div guage;
  352. X    x_inc := 0;
  353. X    y_inc := 0;
  354. X    case new_dir of
  355. X      or$up     : y_inc := -1;
  356. X      or$down   : y_inc :=  1;
  357. X      or$right  : x_inc :=  1;
  358. X      or$left   : x_inc := -1;
  359. X    end;
  360. X    x := spos.x_coord + x_inc;
  361. X    y := spos.y_coord + y_inc;
  362. X    if x < 0 OR ELSE x > board_width_x-1 or else
  363. X       y < 0 OR ELSE y > board_width_y-1 then turn := false
  364. X    else begin
  365. X        elt := board[x, y];
  366. X        if elt = wall
  367. X          then turn := false
  368. X          else begin
  369. X            pos.x_coord := spos.x_coord * guage;
  370. X            pos.y_coord := spos.y_coord * guage;
  371. X            turn := true
  372. X          end
  373. X    end
  374. XEND;
  375. X
  376. X{ called after above to clear a dot in a square of the board }
  377. XPROCEDURE board_$clear_dot(* IN pos: gpr_$position_t; 
  378. X                             OUT wasdot, special: boolean *);
  379. XVAR
  380. X    x, y: integer;
  381. X    bm: gpr_$bitmap_desc_t;
  382. X    draw: boolean;
  383. X    drawpos: gpr_$position_t;
  384. XBEGIN
  385. X    x := (pos.x_coord+(halfguage)) div guage;
  386. X    y := (pos.y_coord+(halfguage)) div guage;
  387. X    draw := true;
  388. X    case board[x, y] of
  389. X        wall: {board_$fail(100);} draw := false;
  390. X        ecor: begin
  391. X                draw := false;
  392. X                wasdot := false;
  393. X                special := false;
  394. X              end;
  395. X        dcor: begin
  396. X                bm := dot_bm;
  397. X                wasdot := true;
  398. X                special := false;
  399. X              end;
  400. X        scor: begin
  401. X                bm := sdot_bm;
  402. X                wasdot := true;
  403. X                special := true;
  404. X              end
  405. X    end;
  406. X    board[x, y] := ecor; { erase the dot if there was one}
  407. X    if draw then 
  408. X      begin
  409. X        drawpos.x_coord := x * guage;
  410. X        drawpos.y_coord := y * guage;
  411. X        gpr_$bit_blt(bm, w, 0, drawpos, 0, status);
  412. X      end
  413. XEND;
  414. X
  415. XPROCEDURE board_$show_score(* newscore: integer, newnumpacs: integer *);
  416. XBEGIN
  417. X    if score <> newscore then begin
  418. X        board_$print_integer(score, 'score: %5sd%$', score_x, score_y);
  419. X        board_$print_integer(newscore, 'score: %5sd%$', score_x, score_y);
  420. X        score := newscore
  421. X        end;
  422. X    if numpacs <> newnumpacs then begin
  423. X        board_$print_integer(numpacs, 'pacs left: %5sd%$', pac_x, pac_y);
  424. X        board_$print_integer(newnumpacs, 'pacs left: %5sd%$', pac_x, pac_y);
  425. X        numpacs := newnumpacs
  426. X        end
  427. XEND;
  428. X
  429. END-of-board.mod.pas
  430. echo file: fig.mod.pas
  431. sed 's/^X//' >fig.mod.pas << 'END-of-fig.mod.pas'
  432. XMODULE fig;
  433. X                                                  
  434. X{ ******************************************************** }
  435. X{ ******************************************************** }
  436. X{ *********                                      ********* }
  437. X{ *********    FIG.MOD.PAS                       ********* }
  438. X{ *********                                      ********* }
  439. X{ *********    Written 12/24/84 by Geof Cooper   ********* }
  440. X{ *********                                      ********* }
  441. X{ ******************************************************** }
  442. X{ ******************************************************** }
  443. X{ Copyright (C) 1984, 1985, IMAGEN Corporation                              }
  444. X{ This software may be duplicated in part of in whole so long as [1] this   }
  445. X{ notice is preserved in the copy, and [2] no financial gain is derived     }
  446. X{ from the copy.  Copies of this software other than as restricted above    }
  447. X{ may be made only with the consent of the author.                          }
  448. X                                                  
  449. X%include '/sys/ins/base.ins.pas';
  450. X%include '/sys/ins/error.ins.pas';
  451. X%include '/sys/ins/kbd.ins.pas';
  452. X%include '/sys/ins/gpr.ins.pas';
  453. X%include '/sys/ins/pgm.ins.pas';
  454. X%include '/sys/ins/pad.ins.pas';
  455. X
  456. XDEFINE fig_$create, fig_$refresh, fig_$move, fig_$elapse_time,
  457. X       fig_$turn, fig_$set_velocity, fig_$alloc_fig_bitmaps,
  458. X       fig_$coincident;
  459. X
  460. X%include 'fig.ins.pas';
  461. X
  462. XVAR
  463. X    { pre-stored for fast bit_blt's }
  464. X    fig_$wind: gpr_$window_t := [ [ 0, 0 ], [ guage, guage ] ];
  465. X
  466. X
  467. XPROCEDURE fig_$cs(status: status_$t; position: integer);
  468. XBEGIN
  469. X    if status.all <> status_$ok then
  470. X    begin
  471. X        gpr_$terminate(false, status);
  472. X        writeln('fig_$error(', position:0, ')');
  473. X        error_$print(status);
  474. X        pgm_$exit
  475. X    end
  476. XEND;
  477. X
  478. X
  479. X{ Error 10 }
  480. XPROCEDURE fig_$alloc_fig_bitmaps(* OUT f: fig_$orientations *);
  481. XVAR
  482. X    i           : integer;
  483. X    attr        : gpr_$attribute_desc_t;
  484. X    status      : status_$t;
  485. X    size        : gpr_$offset_t;
  486. XBEGIN
  487. X    gpr_$allocate_attribute_block(attr, status);
  488. X    fig_$cs(status, 11);
  489. X    size.x_size := guage;
  490. X    size.y_size := guage;
  491. X    for i := 0 to num_orientations do
  492. X        begin
  493. X            gpr_$allocate_bitmap(size, 0, attr, f[i], status);
  494. X            fig_$cs(status, 12);
  495. X        end
  496. XEND;
  497. X
  498. XPROCEDURE fig_$create(* IN figures: fig_$orientations;
  499. X                        IN pos_x, pos_y: Integer;
  500. X                        OUT r: fig_$t *);
  501. XVAR           
  502. X    status  : status_$t;
  503. X
  504. XBEGIN
  505. X    new(r);
  506. X
  507. X    r^.figures     := figures;
  508. X    r^.orientation := or$right;
  509. X    r^.velocity    := 0;
  510. X    r^.position.x_coord := pos_x;
  511. X    r^.position.y_coord := pos_y;
  512. XEND {fig_$create};
  513. X
  514. X{ Error 30 }
  515. XPROCEDURE fig_$refresh(* IN r: fig_$t *);
  516. XVAR
  517. X    status: status_$t;
  518. XBEGIN
  519. X    gpr_$bit_blt(r^.figures[r^.orientation], fig_$wind, 0,
  520. X                 r^.position, 0, status);
  521. X    fig_$cs(status, 21);
  522. XEND;
  523. X
  524. X{ Error 40 }
  525. XPROCEDURE fig_$move(* IN r: fig_$t; IN pos: gpr_$position_t *);
  526. X{ ASSUMES that raster op is XOR }
  527. XVAR
  528. X    status: status_$t;
  529. XBEGIN
  530. X    { write it once in its old place, to erase it }
  531. X    fig_$refresh(r);
  532. X    { and write it into its new place, to redraw it }
  533. X    r^.position := pos;
  534. X    fig_$refresh(r);
  535. XEND;
  536. X
  537. X{ Error 50 }
  538. X{ find new position based on current velocity }
  539. XPROCEDURE fig_$elapse_time(* IN r: fig_$t; IN t: PInteger;
  540. X                             OUT newpos: gpr_$position_t *);
  541. XVAR
  542. X    incr: INTEGER;
  543. XBEGIN
  544. X    incr := t * r^.velocity;
  545. X    newpos := r^.position;
  546. X    CASE r^.orientation OF
  547. X      or$up:   newpos.y_coord := newpos.y_coord - incr;
  548. X      or$down: newpos.y_coord := newpos.y_coord + incr;
  549. X      or$right:newpos.x_coord := newpos.x_coord + incr;
  550. X      or$left: newpos.x_coord := newpos.x_coord - incr
  551. X    END
  552. XEND;
  553. X
  554. X{ Error 60 }
  555. XPROCEDURE fig_$turn(* IN r: fig_$t; IN orient: Integer *);
  556. XVAR
  557. X    status: status_$t;
  558. XBEGIN
  559. X    if r^.orientation <> orient then begin
  560. X        { write it once in its old place, to erase it }
  561. X        fig_$refresh(r);
  562. X
  563. X        { change orientation }
  564. X        r^.orientation := orient;
  565. X
  566. X        { write it again to show it }
  567. X        fig_$refresh(r)
  568. X        end
  569. XEND;
  570. X
  571. X{ Error 70 }
  572. XPROCEDURE fig_$set_velocity(* IN r: fig_$t;
  573. X                             IN velocity: PInteger *);
  574. XBEGIN
  575. X    r^.velocity := velocity;
  576. XEND;
  577. X
  578. X
  579. XFUNCTION fig_$coincident(* IN r1, r2: fig_$t *){: BOOLEAN};
  580. XCONST
  581. X    halfguage = guage div 2;
  582. XVAR
  583. X    pos1_x, pos1_y, pos2_x, pos2_y: integer;
  584. XBEGIN
  585. X    pos1_x := r1^.position.x_coord + halfguage;
  586. X    pos1_y := r1^.position.y_coord + halfguage;
  587. X    pos2_x := r2^.position.x_coord + halfguage;
  588. X    pos2_y := r2^.position.y_coord + halfguage;
  589. X    fig_$coincident := (abs(pos1_x - pos2_x) < guage)
  590. X                                  AND
  591. X                       (abs(pos1_y - pos2_y) < guage)
  592. XEND;
  593. X
  594. END-of-fig.mod.pas
  595. echo file: pac.pas
  596. sed 's/^X//' >pac.pas << 'END-of-pac.pas'
  597. XPROGRAM pacm;
  598. X
  599. X{ APOLLO PAC - a pacman like game                                           }
  600. X{                                                                           }
  601. X{ Written January, 1985 by Geoffrey Cooper                                  }
  602. X{                                                                           }
  603. X{ Copyright (C) 1985, IMAGEN Corporation                                    }
  604. X{ This software may be duplicated in part of in whole so long as [1] this   }
  605. X{ notice is preserved in the copy, and [2] no financial gain is derived     }
  606. X{ from the copy.  Copies of this software other than as restricted above    }
  607. X{ may be made only with the consent of the author.                          }
  608. X
  609. X%include '/sys/ins/base.ins.pas';
  610. X%include '/sys/ins/error.ins.pas';
  611. X%include '/sys/ins/kbd.ins.pas';
  612. X%include '/sys/ins/gpr.ins.pas';
  613. X%include '/sys/ins/pgm.ins.pas';
  614. X%include '/sys/ins/pad.ins.pas';
  615. X%include '/sys/ins/time.ins.pas';
  616. X%include '/sys/ins/tone.ins.pas';
  617. X
  618. X%include 'fig.ins.pas';   {mobile_figure module}
  619. X%include 'board.ins.pas'; {pacman_board module}
  620. X
  621. XPROCEDURE pacm_$refresh_all; EXTERN;
  622. XPROCEDURE pacm_$noop; EXTERN;
  623. XPROCEDURE pacm_$refresh_part(IN unobscured, pos_change: boolean); EXTERN;
  624. X
  625. XTYPE
  626. X    ndesc = record
  627. X                tip_x, tip_y: integer;
  628. X                base_x, base_y: integer;
  629. X                inc_x, inc_y: integer
  630. X            end;
  631. X
  632. XCONST
  633. X    pac_init_x = guage;
  634. X    pac_init_y = guage;
  635. X
  636. X    nasty_init_x = guage*29;
  637. X    nasty_init_y = guage*32;
  638. X
  639. X    max_nasties = 15;
  640. X
  641. XVAR
  642. X    play_forever: boolean;
  643. X
  644. X    ndh: array[0..3] of ndesc := [
  645. X        [  (guage div 2),  0, -(guage div 2), -(guage div 2),  0,  1 ],
  646. X        [  0, -(guage div 2), -(guage div 2),  (guage div 2),  1,  0 ],
  647. X        [ -(guage div 2),  0,  (guage div 2), -(guage div 2),  0,  1 ],
  648. X        [  0,  (guage div 2), -(guage div 2), -(guage div 2),  1,  0 ]
  649. X    ];
  650. X
  651. X    screen      : gpr_$bitmap_desc_t;
  652. X    screen_size : gpr_$offset_t;
  653. X
  654. X    pac         : DEFINE fig_$t;
  655. X    nasty       : fig_$t;
  656. X    nasties     : DEFINE array [1..max_nasties] of fig_$t;
  657. X    num_nasties : DEFINE integer;
  658. X    pac_time    : integer32;
  659. X    num_pacs    : integer;
  660. X    screen_rfs  : integer;
  661. X
  662. X    score_dots  : integer;
  663. X    score_bigdots: integer;
  664. X    score        : integer;
  665. X
  666. X    clock_tick  : integer32 := 20000; { 12.5 ticks per second }
  667. X
  668. X    incs: array [1..3] of integer := [ 1, 3, 2 ];
  669. X    nasty_rand   : integer;
  670. X    last_tick   : DEFINE time_$clock_t;
  671. X
  672. X{ Initialize the display, using GPR routines }
  673. XPROCEDURE pacm_$init_gpr;
  674. XCONST
  675. X    bitmap_max_size = 1024;
  676. X    black_and_white = 0;
  677. X    keyset = [ kbd_$up_arrow, kbd_$down_arrow, 
  678. X               kbd_$left_arrow, kbd_$right_arrow,
  679. X               kbd_$hold2,
  680. X               kbd_$l_box_arrow, kbd_$r_box_arrow, 
  681. X               kbd_$down_box_arrow2, kbd_$up_box_arrow2,
  682. X               kbd_$next_win,
  683. X               'f', 's',
  684. X               'l',
  685. X               'q' ];
  686. X    buttonset = ['a', 'A', 'b', 'c']; 
  687. X    locatorset  = [];
  688. X    raster_op_XOR = 6;
  689. XVAR
  690. X    attr:           gpr_$attribute_desc_t;
  691. X    status:         status_$t;
  692. X    unobscured:     BOOLEAN;
  693. X    font_width, 
  694. X    font_height,
  695. X    font_length,
  696. X    font_id:        INTEGER;
  697. X    font_name:      STRING;
  698. X    plane:          integer;
  699. X
  700. XBEGIN
  701. X    { Initialize the a displayed bitmap filling the frame }
  702. X    screen_size.x_size := bitmap_max_size;
  703. X    screen_size.y_size := bitmap_max_size;
  704. X    gpr_$init( gpr_$direct, stream_$stdout, screen_size, black_and_white,
  705. X                    screen, status );
  706. X
  707. X    gpr_$inq_bitmap_dimensions(screen, screen_size, plane, status);
  708. X
  709. X    gpr_$set_obscured_opt(gpr_$block_if_obs, status);
  710. X
  711. X    { Set up bitmap to use the default font }
  712. X    pad_$inq_font( stream_$stdout, font_width, font_height, 
  713. X                      font_name, sizeof(String), font_length, status );
  714. X    gpr_$load_font_file( font_name, font_length, font_id, status );
  715. X    gpr_$set_text_font( font_id, status );
  716. X
  717. X    { enable input from mouse }
  718. X    gpr_$enable_input( gpr_$keystroke, keyset, status);
  719. X
  720. X    gpr_$set_raster_op(0, raster_op_XOR, status);
  721. X
  722. X    gpr_$set_cursor_active( true, status );
  723. XEND;
  724. X
  725. XPROCEDURE add_time( IN OUT t: time_$clock_t; ticktime: linteger );
  726. XVAR
  727. X    i: linteger;
  728. XBEGIN
  729. X    i := t.low32 + ticktime;
  730. X    if i < t.low32 then t.high16 := t.high16 + 1;
  731. X    t.low32 := i
  732. XEND;
  733. X
  734. XPROCEDURE pregnant_pause;
  735. XCONST
  736. X    ticktime = 156250;
  737. XVAR
  738. X    t           :time_$clock_t;
  739. X    status      : status_$t;
  740. XBEGIN
  741. X    t.high16 := 0;
  742. X    t.low32  := ticktime;
  743. X    time_$wait( time_$relative, t, status );
  744. X    add_time(last_tick, ticktime)
  745. XEND;
  746. X
  747. XPROCEDURE pacm_$init_pac;
  748. XVAR
  749. X    pac_bitmaps : fig_$orientations;
  750. X    pac_size    : gpr_$offset_t;
  751. X    status      : status_$t;
  752. X    point       : gpr_$position_t;
  753. X    unobsc      : boolean;
  754. X    i,j         : integer;
  755. X    attr        : gpr_$attribute_desc_t;
  756. XCONST
  757. X    wedge_begin = (guage div 2) - (guage div 8) - 1;
  758. X    wedge_end   = (guage div 2) + (guage div 8) + 1;
  759. XBEGIN
  760. X    gpr_$allocate_attribute_block(attr, status);
  761. X    pac_size.x_size := guage;
  762. X    pac_size.y_size := guage;
  763. X    point.x_coord := guage div 2;
  764. X    point.y_coord := guage div 2;
  765. X    unobsc := gpr_$acquire_display(status);
  766. X    for i := 0 to 3 do
  767. X    begin
  768. X        gpr_$allocate_bitmap(pac_size, 0, attr,
  769. X                             pac_bitmaps[i], status);
  770. X        gpr_$set_bitmap(pac_bitmaps[i], status);
  771. X        gpr_$circle_filled(point, (guage div 2) - 1, status);
  772. X        gpr_$set_draw_value(0, status);
  773. X
  774. X        for j := wedge_begin to wedge_end do
  775. X          begin
  776. X            gpr_$move((guage div 2), (guage div 2), status);
  777. X            CASE i OF
  778. X                0: gpr_$line( guage,  j    , status);
  779. X                1: gpr_$line( j    ,  0    , status);
  780. X                2: gpr_$line( 0    ,  j    , status);
  781. X                3: gpr_$line( j    ,  guage, status);
  782. X            END
  783. X          end;
  784. X        gpr_$set_draw_value(1, status)
  785. X    END;
  786. X    fig_$create(pac_bitmaps, pac_init_x, pac_init_y, pac);
  787. X    fig_$set_velocity(pac, (guage div 2) + (guage div 8));
  788. X    gpr_$release_display(status);
  789. XEND;
  790. X
  791. XPROCEDURE pacm_$init_nasty;
  792. XCONST
  793. X    pi = 3.14159;
  794. X    right_angle = pi/2;
  795. X    mag = guage div 2;
  796. XVAR
  797. X    nasty_bitmaps : fig_$orientations;
  798. X    size          : gpr_$offset_t;
  799. X    status        : status_$t;
  800. X    unobsc        : boolean;
  801. X    i,j           : integer;
  802. X    attr          : gpr_$attribute_desc_t;
  803. X    org           : gpr_$position_t;
  804. X    org0          : gpr_$position_t;
  805. X    angle         : real;
  806. X    x, y          : integer;
  807. X    x1, y1        : integer;
  808. XBEGIN
  809. X    org.x_coord := guage div 2;
  810. X    org.y_coord := guage div 2;
  811. X    org0.x_coord := 0;
  812. X    org0.y_coord := 0;
  813. X    gpr_$allocate_attribute_block(attr, status);
  814. X    size.x_size := guage;
  815. X    size.y_size := guage;
  816. X    unobsc := gpr_$acquire_display(status);
  817. X    for i := 0 to 3 do
  818. X        begin
  819. X            gpr_$allocate_bitmap(size, 0, attr, nasty_bitmaps[i], status);
  820. X            gpr_$set_bitmap(nasty_bitmaps[i], status);
  821. X            gpr_$set_coordinate_origin(org, status);
  822. X
  823. X            gpr_$move(ndh[i].tip_x, ndh[i].tip_y, status);
  824. X            for j := 0 to guage-1 do begin
  825. X                gpr_$line(ndh[i].base_x, ndh[i].base_y, status);
  826. X                gpr_$move(ndh[i].tip_x, ndh[i].tip_y, status);
  827. X                ndh[i].base_x := ndh[i].base_x + ndh[i].inc_x;
  828. X                ndh[i].base_y := ndh[i].base_y + ndh[i].inc_y
  829. X                end;
  830. X            gpr_$set_coordinate_origin(org0, status);
  831. X        end;
  832. X    fig_$create(nasty_bitmaps, nasty_init_x, nasty_init_y, nasty);
  833. X    fig_$set_velocity(nasty, (guage div 2));
  834. X    gpr_$release_display(status);
  835. X    nasty_rand := 0;
  836. X    nasties[1] := nasty;
  837. X    num_nasties := 1
  838. XEND;
  839. X
  840. XPROCEDURE pacm_$add_nasty(OUT n: fig_$t);
  841. XBEGIN
  842. X    fig_$create(nasty^.figures, nasty_init_x, nasty_init_y, n);
  843. X    fig_$refresh(n);
  844. X    fig_$set_velocity(n, (guage div 2));
  845. XEND;
  846. X
  847. XPROCEDURE pacm_$tick_nasty(nasty: fig_$t);
  848. X{
  849. X    Algorithm for controlling the nasty:
  850. X        using absolute difference between nasty x and y
  851. X        positions and pac's, prefer the correct direction
  852. X        in each axis, with the axis with the largest distance
  853. X        having priority.
  854. X
  855. X        The other two possible turns are random, except that
  856. X        the `about face' direction has low priority.
  857. X    Then:
  858. X        Only try all four possibilities when you have hit
  859. X        a wall.
  860. X
  861. X        Only allow yourself to about face every
  862. X        ALLOW_REVERSE moves unless you have hit a wall.
  863. X}
  864. XCONST
  865. X    allow_reverse = 50;
  866. XVAR
  867. X    pos: gpr_$position_t;
  868. X    turnpos: gpr_$position_t;
  869. X    i: integer;
  870. X    orient: integer;
  871. X    can_turn: boolean;
  872. X    no_change: boolean;
  873. X    bound: integer;
  874. X    t           :time_$clock_t;
  875. X    turns: array[0..3] of integer;
  876. X    diff_x, diff_y: integer;
  877. X    about_face: integer;
  878. XBEGIN
  879. X    fig_$elapse_time(nasty, 1, pos);
  880. X    board_$try_pac_position(pos);
  881. X
  882. X    nasty_rand := nasty_rand + 1;
  883. X    no_change := pos = nasty^.position;
  884. X    bound := 1;
  885. X    if no_change then bound := 3;
  886. X
  887. X    { find priorities for directions }
  888. X    diff_x := pos.x_coord - pac^.position.x_coord;
  889. X    diff_y := pos.y_coord - pac^.position.y_coord;
  890. X    if abs(diff_x) > abs(diff_y) then begin
  891. X        if diff_x > 0 then begin
  892. X            turns[0] := or$left;
  893. X            turns[2] := or$right
  894. X            end
  895. X        else begin
  896. X            turns[0] := or$right;
  897. X            turns[2] := or$left
  898. X            end;
  899. X        if diff_y > 0 then begin
  900. X            turns[1]:= or$up;
  901. X            turns[3] := or$down
  902. X            end
  903. X        else begin
  904. X            turns[1] := or$down;
  905. X            turns[3] := or$up
  906. X            end
  907. X        end
  908. X    else begin
  909. X        if diff_x > 0 then begin
  910. X            turns[1] := or$left;
  911. X            turns[3] := or$right
  912. X            end
  913. X        else begin
  914. X            turns[1] := or$right;
  915. X            turns[3] := or$left
  916. X            end;
  917. X        if diff_y > 0 then begin
  918. X            turns[0]:= or$up;
  919. X            turns[2] := or$down
  920. X            end
  921. X        else begin
  922. X            turns[0] := or$down;
  923. X            turns[2] := or$up
  924. X            end
  925. X    end;
  926. X    about_face := ((nasty^.orientation+2) mod 4);
  927. X    if turns[2] = about_face then begin
  928. X        i := turns[3];
  929. X        turns[3] := turns[2];
  930. X        turns[2] := i
  931. X        end;
  932. X    can_turn := false;
  933. X    for i := 0 to bound do begin
  934. X        orient := turns[i];
  935. X        if no_change or else
  936. X           orient <> about_face or else
  937. X           (nasty_rand mod allow_reverse) = 0 then begin
  938. X            turnpos := pos;
  939. X            board_$can_turn(turnpos, orient, can_turn);
  940. X            end;
  941. X        if can_turn then exit
  942. X        end;
  943. X    if can_turn and then orient <> nasty^.orientation then begin
  944. X        fig_$turn(nasty, orient);
  945. X        pos := turnpos
  946. X        end;
  947. X    fig_$move(nasty, pos);
  948. X    { check scores }
  949. X    if fig_$coincident(nasty, pac) then begin
  950. X        num_pacs := num_pacs - 1;
  951. X        t.high16 := 0;
  952. X        t.low32  := 10000;
  953. X        tone_$time(t);
  954. X        add_time(last_tick, 10000);
  955. X        pos.x_coord := pac_init_x;
  956. X        pos.y_coord := pac_init_y;
  957. X        fig_$move(pac, pos);
  958. X        pos.x_coord := nasty_init_x;
  959. X        pos.y_coord := nasty_init_y;
  960. X        fig_$move(nasty, pos);
  961. X        pregnant_pause;
  962. X        end
  963. XEND;
  964. X
  965. XPROCEDURE pacm_$tick_all_nasties;
  966. XVAR
  967. X    i: integer;
  968. XBEGIN
  969. X    for i := 1 to num_nasties do
  970. X        pacm_$tick_nasty(nasties[i]);
  971. XEND;
  972. X
  973. XPROCEDURE pacm_$tick;
  974. XVAR
  975. X    i           : linteger;
  976. X    status      : status_$t;
  977. X    unobsc      : boolean;
  978. X    release     : boolean;
  979. XBEGIN
  980. X    add_time(last_tick, clock_tick);
  981. X    release := (pac_time mod 16) = 0;
  982. X    pac_time := pac_time + 1;
  983. X    if release then gpr_$release_display(status);
  984. X    time_$wait( time_$absolute, last_tick, status );
  985. X    time_$clock(last_tick);
  986. X    if release then unobsc := gpr_$acquire_display(status);
  987. XEND;
  988. X
  989. X
  990. XPROCEDURE pacm_$play;
  991. XVAR
  992. X    c           : char; 
  993. X    pos         : gpr_$position_t;
  994. X    event       : gpr_$event_t;
  995. X    cp          : ^char;
  996. X    status      : status_$t;
  997. X    unobsc      : boolean;
  998. X    wasdot      : boolean;
  999. X    special     : boolean;
  1000. X    is_q_orient : boolean;
  1001. X    can_turn    : boolean;
  1002. X    q_orient    : board_$direction;
  1003. X    num_dots    : integer;
  1004. X    num_bigdots : integer;
  1005. X    total_dots  : integer;
  1006. X    total_sdots : integer;
  1007. X    i           : integer;
  1008. X    num_events  : integer;
  1009. X    num_passes  : integer32;
  1010. X
  1011. X    u1, u2      : univ_ptr;
  1012. XBEGIN
  1013. X    num_dots := 0;
  1014. X    num_bigdots := 0;
  1015. X    score_dots := 0;
  1016. X    score_bigdots := 0;
  1017. X    score := 0;
  1018. X    pac_time := 0;
  1019. X    num_pacs := 5;
  1020. X    screen_rfs := 0;
  1021. X    pacm_$init_gpr;
  1022. X    pacm_$init_pac;
  1023. X    pacm_$init_nasty;
  1024. X    unobsc := gpr_$acquire_display(status);
  1025. X    gpr_$set_bitmap(screen, status);
  1026. X    u1 := addr(pacm_$refresh_part);
  1027. X    u2 := addr(pacm_$noop);
  1028. X    gpr_$set_refresh_entry(addr(pacm_$refresh_part), addr(pacm_$noop), status);
  1029. X    board_$init(screen, screen_size, num_pacs);
  1030. X    board_$get_num_dots(total_dots, total_sdots);
  1031. X    pacm_$refresh_all;
  1032. X    is_q_orient := false;
  1033. X    c := chr(0);
  1034. X    cp := addr(c);
  1035. X    num_events := 2;
  1036. X    num_passes := 0;
  1037. X    REPEAT
  1038. X        repeat
  1039. X            unobsc := gpr_$cond_event_wait(event, c, pos, status);
  1040. X            IF status.all <> status_$OK THEN
  1041. X                BEGIN
  1042. X                    error_$print(status);
  1043. X                    pgm_$exit;
  1044. X                END;
  1045. X            IF event = gpr_$keystroke THEN
  1046. X                CASE c OF
  1047. X                  kbd_$right_arrow:
  1048. X                        begin
  1049. X                            is_q_orient := true;
  1050. X                            q_orient := or$right
  1051. X                        end;
  1052. X                  kbd_$up_arrow:
  1053. X                        begin
  1054. X                            is_q_orient := true;
  1055. X                            q_orient := or$up
  1056. X                        end;
  1057. X                  kbd_$left_arrow:
  1058. X                        begin
  1059. X                            is_q_orient := true;
  1060. X                            q_orient := or$left
  1061. X                        end;
  1062. X                  kbd_$down_arrow:
  1063. X                        begin
  1064. X                            is_q_orient := true;
  1065. X                            q_orient := or$down
  1066. X                        end;
  1067. X                  'f':
  1068. X                        begin
  1069. X                            clock_tick := clock_tick - 1000;
  1070. X                            if clock_tick < 0 then clock_tick := 0;
  1071. X                        end;
  1072. X                  's':
  1073. X                        clock_tick := clock_tick + 1000;
  1074. X                  'l':
  1075. X                        pacm_$refresh_all;
  1076. X                  kbd_$up_box_arrow2:
  1077. X                        begin
  1078. X                            if pac^.velocity < (guage-1) then
  1079. X                                fig_$set_velocity(pac, pac^.velocity+1)
  1080. X                        end;
  1081. X                  kbd_$down_box_arrow2:
  1082. X                        begin
  1083. X                            if pac^.velocity <> 0 then
  1084. X                                fig_$set_velocity(pac, pac^.velocity - 1)
  1085. X                        end;
  1086. X                  kbd_$hold2:
  1087. X                        begin
  1088. X                            repeat
  1089. X                                unobsc := gpr_$event_wait(event, c, pos, status);
  1090. X                            until (event = gpr_$keystroke) AND (c = kbd_$hold2);
  1091. X                            num_events := 2
  1092. X                        end;
  1093. X                  'q':;
  1094. X                  OTHERWISE
  1095. X                        { ignore other characters -- they are defined so }
  1096. X                        { that pressing them by accident doesn't spoil   }
  1097. X                        { the game.                                      }
  1098. X                END;
  1099. X                num_events := num_events + 1;
  1100. X        UNTIL event <> gpr_$keystroke;
  1101. X
  1102. X        { num_passes is to prevent an initial "spurt" when libraries }
  1103. X        { are loaded the first time a pac is run in a process }
  1104. X        num_passes := num_passes + 1;
  1105. X        if (num_events > 1) or (num_passes < 10) then
  1106. X            time_$clock(last_tick);
  1107. X        num_events := 0;
  1108. X
  1109. X        pacm_$tick;
  1110. X        fig_$elapse_time(pac, 1, pos);
  1111. X
  1112. X        { stop pac man at boundary }
  1113. X        board_$try_pac_position(pos);
  1114. X        board_$clear_dot(pos, wasdot, special);
  1115. X        if wasdot then
  1116. X            if special then
  1117. X              begin
  1118. X                num_bigdots := num_bigdots + 1;
  1119. X                score_bigdots := score_bigdots + 1;
  1120. X                score := score + 5;
  1121. X              end
  1122. X            else
  1123. X              begin
  1124. X                num_dots := num_dots + 1;
  1125. X                score_dots := score_dots + 1;
  1126. X                score := score + 1;
  1127. X              end;
  1128. X        board_$show_score( score, num_pacs );
  1129. X        if is_q_orient then
  1130. X          begin
  1131. X            if pac^.orientation = q_orient then
  1132. X                is_q_orient := false
  1133. X            else
  1134. X              begin
  1135. X                board_$can_turn(pos, q_orient, can_turn);
  1136. X                if can_turn then
  1137. X                  begin
  1138. X                    fig_$turn(pac, q_orient);
  1139. X                    is_q_orient := false
  1140. X                  end
  1141. X              end
  1142. X          end;
  1143. X        fig_$move(pac, pos);
  1144. X
  1145. X        { move /nasty/ }
  1146. X        pacm_$tick_all_nasties;
  1147. X
  1148. X        if num_dots = total_dots  THEN
  1149. X          begin
  1150. X            screen_rfs := screen_rfs + 1;
  1151. X            board_$reinit;
  1152. X            fig_$refresh(pac);
  1153. X            for i := 1 to num_nasties do
  1154. X                fig_$refresh(nasties[i]);
  1155. X            num_bigdots := 0;
  1156. X            num_dots := 0;
  1157. X            for i := 1 to num_nasties do
  1158. X                if nasties[i]^.velocity < (guage-1) then
  1159. X                    fig_$set_velocity(nasties[i], nasties[i]^.velocity+1);
  1160. X            if num_nasties < max_nasties then begin
  1161. X                num_nasties := num_nasties + 1;
  1162. X                pacm_$add_nasty(nasties[num_nasties])
  1163. X                end;
  1164. X            num_pacs := num_pacs + 1;
  1165. X            time_$clock(last_tick);
  1166. X          end
  1167. X    UNTIL (c = 'q') OR ((num_pacs <= 0) AND (NOT play_forever));
  1168. X    { Read any extra characters that were typed but not read yet }
  1169. X    { This is necessary since otherwise special characters can get }
  1170. X    { left in the input stream and kill the csh }
  1171. X    repeat
  1172. X        unobsc := gpr_$cond_event_wait(event, c, pos, status);
  1173. X    until (event <> gpr_$keystroke) OR (status.all <> status_$ok);
  1174. X
  1175. X    gpr_$release_display(status);
  1176. X    gpr_$terminate(false, status);
  1177. X    i := 6 + screen_rfs - num_pacs;
  1178. X    if num_pacs <> 0 then
  1179. X        writeln('PAC score after ', i:0, ' pacs:')
  1180. X    else
  1181. X        writeln('Final PAC score (', i:0, ' pacs):');
  1182. X    writeln('    ', score:0, ' points, ', screen_rfs:0, ' entire screens consumed.')
  1183. XEND;
  1184. X
  1185. XPROCEDURE pacm_$help;
  1186. XVAR
  1187. X    status      : status_$t;
  1188. X    argv_ptr    : pgm_$argv_ptr;
  1189. X    argc        : integer;
  1190. XBEGIN
  1191. X    pgm_$get_args(argc, argv_ptr);
  1192. X    play_forever := false;
  1193. X    if argc = 7 then
  1194. X      begin
  1195. X        writeln('Pac - play forever mode.');
  1196. X        play_forever := true;
  1197. X        argc := 0;
  1198. X      end;
  1199. X    if argc > 1 then
  1200. X      begin
  1201. X        writeln('pac - play pac man.');
  1202. X        writeln('usage: pac');
  1203. X        writeln('[An argument gives this help, no argument plays the game]');
  1204. X        writeln('PAC is an adaptation of the ever-popular ATARI game, PACMAN(C).');
  1205. X        writeln('You control a round PAC, which runs from the scurrying');
  1206. X        writeln('NASTIES.  The nasties seek the PAC like heat-seeking missiles.');
  1207. X        writeln('When they catch it, it is destroyed, and both nasty and pac');
  1208. X        writeln('go to neutral corners.  You start the game with five PACs.');
  1209. X        writeln;
  1210. X        writeln('The PAC accumulates points by eating solid dots [1 point] and');
  1211. X        writeln('hollow dots [5 points].  When all the dots on the screen are');
  1212. X        writeln('eaten, the screen is re-filled, and you are given one more ');
  1213. X        writeln('PAC "life."  The game also gets tougher each time the screen');
  1214. X        writeln('refreshes, since a new nasty appears, and all existing nasties');
  1215. X        writeln('get a bit faster.');
  1216. X        writeln;
  1217. X        writeln('Control the PAC by using the arrow keys.  Pressing an');
  1218. X        writeln('arrow key queues a request to turn in that direction.');
  1219. X        writeln('The request is processed when the turn is first possible.');
  1220. X        writeln('For best results, do not hold down the arrow keys.');
  1221. X        writeln;
  1222. X        writeln('The UP and DOWN block arrows make the PAC get slower and faster,');
  1223. X        writeln('respectively.  A slow PAC is more maneuverable, but must');
  1224. X        writeln('be more strategic to escape the nasties.');
  1225. X        writeln;
  1226. X        writeln('Additional commands:');
  1227. X        writeln('    ''q''  - quits the game immediately');
  1228. X        writeln('    ''l''  - manual refresh of screen');
  1229. X        writeln('    HOLD - stops action until you press hold again');
  1230. X        writeln('    POP  - the game stops if the window is obscured');
  1231. X        writeln('    ''f''  - speed  up the game clock (decrease tick time)');
  1232. X        writeln('    ''s''  - slow down the game clock (increase tick time)');
  1233. X        writeln('If you start with a window that is too small, just enlarge it.');
  1234. X        writeln;
  1235. X        writeln('Run this program again without arguments to play.');
  1236. X        pgm_$exit
  1237. X      end
  1238. X    else
  1239. X      begin
  1240. X        writeln('Pac:  type ''q'' to quit, then ''pac help'' to get instructions');
  1241. X        pregnant_pause;
  1242. X      end
  1243. XEND;
  1244. X
  1245. XBEGIN
  1246. X    pacm_$help;
  1247. X    pacm_$play;
  1248. XEND.
  1249. END-of-pac.pas
  1250. echo file: pac_refresh.pas
  1251. sed 's/^X//' >pac_refresh.pas << 'END-of-pac_refresh.pas'
  1252. XMODULE pac_refresh;
  1253. X
  1254. X{ Copyright (C) 1985, IMAGEN Corporation                                    }
  1255. X{ This software may be duplicated in part of in whole so long as [1] this   }
  1256. X{ notice is preserved in the copy, and [2] no financial gain is derived     }
  1257. X{ from the copy.  Copies of this software other than as restricted above    }
  1258. X{ may be made only with the consent of the author.                          }
  1259. X
  1260. X%include '/sys/ins/base.ins.pas';
  1261. X%include '/sys/ins/error.ins.pas';
  1262. X%include '/sys/ins/kbd.ins.pas';
  1263. X%include '/sys/ins/gpr.ins.pas';
  1264. X%include '/sys/ins/pgm.ins.pas';
  1265. X%include '/sys/ins/pad.ins.pas';
  1266. X%include '/sys/ins/time.ins.pas';
  1267. X%include '/sys/ins/tone.ins.pas';
  1268. X
  1269. X%include 'fig.ins.pas';   {mobile_figure module}
  1270. X%include 'board.ins.pas'; {pacman_board module}
  1271. X
  1272. X
  1273. XVAR
  1274. X    last_tick: extern time_$clock_t;
  1275. X    pac: extern fig_$t;
  1276. X    nasties: extern array[1..15] of fig_$t;
  1277. X    num_nasties: extern integer;
  1278. X
  1279. XPROCEDURE pacm_$noop;
  1280. XBEGIN
  1281. X    { do nothing }
  1282. XEND;
  1283. X
  1284. XPROCEDURE pacm_$refresh_all;
  1285. XVAR
  1286. X    i: integer;
  1287. XBEGIN
  1288. X    board_$draw_board;
  1289. X    fig_$refresh(pac);
  1290. X    for i := 1 to num_nasties do
  1291. X        fig_$refresh(nasties[i]);
  1292. X    time_$clock(last_tick)
  1293. XEND;
  1294. X
  1295. XPROCEDURE pacm_$refresh_part(IN unobscured, pos_change: boolean);
  1296. XBEGIN
  1297. X    if unobscured or pos_change then
  1298. X        pacm_$refresh_all;
  1299. XEND;
  1300. X
  1301. END-of-pac_refresh.pas
  1302. exit
  1303.  
  1304.  
  1305. /* End of text from mirror:mod.sources */
  1306.