home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / gnu / emacs / sources / 982 < prev    next >
Encoding:
Text File  |  1993-01-28  |  20.6 KB  |  710 lines
  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!pipex!pavo.csi.cam.ac.uk!camcus!nj104
  3. From: nj104@cus.cam.ac.uk (Neil Jerram)
  4. Subject: ATC game
  5. Message-ID: <NJ104.93Jan28224154@apus.cus.cam.ac.uk>
  6. Sender: news@infodev.cam.ac.uk (USENET news)
  7. Nntp-Posting-Host: apus.cus.cam.ac.uk
  8. Organization: U of Cambridge, England
  9. Distribution: gnu
  10. Date: Thu, 28 Jan 1993 22:41:59 GMT
  11. Lines: 697
  12.  
  13. Here is the first release of my Emacs Lisp version of ATC.
  14.  
  15. Thanks to everyone who wrote with support when I was worried about
  16. copyright on the original game.  For the record, I have never seen any
  17. source code for ATC that wasn't written by myself, so I guess I'm
  18. safe.  In fact I'm rather afraid that aficionadoes of the game may be
  19. disappointed by any departures from the original design: any such
  20. discrepancies are thanks to my bad memory, not deliberate, and I'll be
  21. glad to try and improve the program according to authoritative
  22. suggestions in future releases.
  23.  
  24. This posting contains the Lisp code itself, and will be followed by
  25. another posting with a Texinfo file documenting it.
  26.  
  27. Now who is going to write super-mario-3.el ?!
  28.  
  29. - Neil -
  30.  
  31. ;----------1.5cm seam allowance not included--------------------
  32. ; atc.el
  33. ;
  34. ; by Neil Jerram <nj104@cus.cam.ac.uk>
  35. ;
  36. ; version 1.0, Thu Jan 28 22:39:16 1993
  37. ;
  38. ;;; This program is free software; you can redistribute it and/or modify
  39. ;;; it under the terms of the GNU General Public License as published by
  40. ;;; the Free Software Foundation; either version 1, or (at your option)
  41. ;;; any later version.
  42. ;;;
  43. ;;; This program is distributed in the hope that it will be useful,
  44. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  45. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  46. ;;; GNU General Public License for more details.
  47. ;;;
  48. ;;; The GNU General Public License is available by anonymous ftp from
  49. ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  50. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  51. ;;; USA.
  52. ;
  53. ; User options.
  54. ; The following variables may be altered by the player to
  55. ; change the pace and difficulty of the game.
  56.  
  57. (defvar atc-nb-planes 26
  58.   "*Total number of planes in the game (maximum 26).")
  59. (defvar atc-initial-delay 5000
  60.   "*The initial time lapse between successive plane movements.")
  61. (defvar atc-acceleration 2
  62.   "*If this variable is non-zero, successive plane movements will
  63. become faster and faster as the game progresses.  The higher the 
  64. value of the variable, the faster the speed-up.")
  65. (defvar atc-mean-separation 10
  66.   "*Roughly speaking, the average number of moves between new planes.")
  67. (defvar atc-%-airports 50
  68.   "*When a new plane is started, a provenance and a destination are
  69. chosen randomly for it.  This variable governs how many of the
  70. choices will be airports and how many will be areas: a value of 0
  71. means all areas; 100 means all airports.")
  72.  
  73. ; Internal variables.
  74.  
  75. (defvar atc-delay nil
  76.   "The current time lapse between successive plane movements.")
  77. (defvar atc-plane nil
  78.   "Name of plane currently being/about to be commanded.")
  79. (defvar atc-command nil
  80.   "Name of command being/about to be executed.")
  81. (defvar atc-arg nil
  82.   "Argument of command under execution, where applicable.")
  83. (defvar atc-command-2-key-list
  84.   (list ??)                ; Information.
  85.   "List of commands requiring no argument.")
  86. (defvar atc-command-3-key-list
  87.   (list ?A ?L ?R)            ; Altitude, Left, Right.
  88.   "List of commands requiring an argument.")
  89. (defvar atc-command-key-list
  90.   (append atc-command-2-key-list atc-command-3-key-list)
  91.   "List of all ATC commands.")
  92. (defvar atc-last-plane -1
  93.   "Number of last plane to be started so far (0..25).")
  94. (defvar atc-first-plane -1
  95.   "Number of earliest plane still in play (0..25).")
  96. (defvar atc-moves-since-last-start 0
  97.   "Number of moves since last plane was started.")
  98. (defvar atc-plane-info nil
  99.   "Vector containing all plane information.")
  100. (defvar atc-game-in-progress nil
  101.   "A variable which is true if a game is in progress.")
  102.  
  103. ; Constants describing the nine items of plane information.
  104.  
  105. (defconst X 0)
  106. (defconst Y 1)
  107. (defconst U 2)
  108. (defconst V 3)
  109. (defconst ALTITUDE 4)
  110. (defconst DIR-CHANGE 5)
  111. (defconst ALT-CHANGE 6)
  112. (defconst PROVENANCE 7)
  113. (defconst DESTINATION 8)
  114.  
  115. ; Function definitions.
  116.  
  117. (defun atc ()
  118.   "Play Air Traffic Control: either a new game or
  119. the resumption of a temporarily suspended game."
  120.   (interactive)
  121.   (if (and atc-game-in-progress
  122.        (y-or-n-p "Resume previously started game ? "))
  123.       (atc-resume-game)
  124.     (atc-new-game)))
  125.  
  126. (defun atc-new-game ()
  127.   "Play a new game of Air Traffic Control."
  128.   (interactive)
  129.   (atc-prepare-game-buffer)
  130.   (atc-zero-plane-info)
  131.   (if (y-or-n-p "Are you ready to play ATC ? ")
  132.       (atc-main-loop)))
  133.  
  134. (defun atc-resume-game ()
  135.   "Resume a suspended game of Air Traffic Control."
  136.   (interactive)
  137.   (atc-prepare-game-buffer)
  138.   (atc-draw-all-planes)
  139.   (if (y-or-n-p "Are you ready to resume playing ATC ? ")
  140.       (atc-main-loop)))
  141.  
  142. (defun atc-prepare-game-buffer ()
  143.   (switch-to-buffer "*Air Traffic Control*")
  144.   (erase-buffer)
  145.   (atc-insert-board)
  146.   (delete-other-windows)
  147.   (goto-char (point-min))
  148.   (sit-for 0))
  149.   
  150. (defun atc-zero-plane-info ()
  151.   (setq atc-plane-info 
  152.     (make-vector atc-nb-planes (make-vector 9 'nil)))
  153.   ; The nine items of information for each plane are:
  154.   ; x, y, u, v, altitude, dir-change, alt-change,
  155.   ; provenance, destination.
  156.   (setq atc-first-plane 0
  157.     atc-last-plane -1
  158.     atc-plane nil
  159.     atc-command nil
  160.     atc-arg nil
  161.     atc-delay atc-initial-delay)
  162.   (atc-start-a-plane))
  163.  
  164. (defun atc-main-loop ()
  165.   (setq atc-game-in-progress t)
  166.   (let ((stop-game-catch
  167.      (catch 'stop-game
  168.        (let (count)
  169.          (while t
  170.            (setq count atc-delay
  171.              atc-delay (- atc-delay atc-acceleration))
  172.            (while (> (setq count (1- count)) 0)
  173.          (if (input-pending-p)
  174.              (atc-interpret-input (read-char))))
  175.            (atc-move-planes)
  176.            (atc-check-crashes)
  177.            (setq atc-moves-since-last-start 
  178.              (1+ atc-moves-since-last-start))
  179.            (and (< atc-last-plane (1- atc-nb-planes))
  180.             (> (atc-rand atc-moves-since-last-start) 
  181.                atc-mean-separation)
  182.             (atc-start-a-plane))
  183.            (sit-for 0)))
  184.        nil)))
  185.     (if stop-game-catch
  186.     (cond
  187.      ((stringp stop-game-catch)
  188.       (atc-end-game stop-game-catch))
  189.      ((eq stop-game-catch 'quick-change)
  190.       (atc-quick-change))
  191.      ((eq stop-game-catch 'suspend)
  192.       (atc-suspend-game))))))
  193.  
  194. (defun atc-end-game (message)
  195.   (ding)
  196.   (goto-char (point-min))
  197.   (insert message ?\n ?\n)
  198.   (setq atc-game-in-progress nil))
  199.  
  200. (defun atc-quick-change ()
  201.   (switch-to-buffer (other-buffer))
  202.   (sit-for 0))
  203.  
  204. (defun atc-suspend-game ()
  205.   (if (y-or-n-p "Game suspended.  Resume immediately ? ")
  206.       (atc-main-loop)))
  207.  
  208. (defun atc-interpret-input (key)
  209.   (setq key (upcase key))
  210.   (cond
  211.    ((= key ?\e)
  212.     (throw 'stop-game 'quick-change))
  213.    ((= key ?\C-z)
  214.     (throw 'stop-game 'suspend))
  215.    ((= key ?\C-?)
  216.     (setq atc-plane nil
  217.       atc-command nil
  218.       atc-arg nil)
  219.     (atc-echo-command "   "))
  220.    (atc-command
  221.     (and (>= key ?0)
  222.      (<= key ?9)
  223.      (setq atc-arg (- key ?0))
  224.      (atc-echo-command (concat (list atc-plane atc-command key)))
  225.      (atc-execute-command)))
  226.    (atc-plane
  227.     (and (memq key atc-command-key-list)
  228.      (setq atc-command key)
  229.      (atc-echo-command (concat (list atc-plane atc-command ? )))
  230.      (memq key atc-command-2-key-list)
  231.      (atc-execute-command)))
  232.    (t
  233.     (and (>= key ?A)
  234.      (<= key ?Z)
  235.      (setq atc-plane key)
  236.      (atc-echo-command (concat (list atc-plane ?  ? ))))))
  237.   t)
  238.  
  239. (defun atc-echo-command (com)
  240.   (goto-char 1)
  241.   (insert "! " com)
  242.   (zap-to-char 1 ?\n)
  243.   (goto-char 1)
  244.   (sit-for 0))
  245.  
  246. (defun atc-execute-command ()
  247.   ; Check that named plane has been started.
  248.   (setq atc-plane (- atc-plane ?A))
  249.   (if (> atc-plane atc-last-plane)
  250.       nil
  251.     (let ((plane-info (aref atc-plane-info atc-plane)))
  252.       (if (null (aref plane-info ALTITUDE))
  253.       nil
  254.     (cond
  255.      ((= atc-command ?A)        ; Change altitude.
  256.       (if (and (= (aref plane-info ALTITUDE) -1) ; Awaiting take-off.
  257.            (= atc-arg 1))
  258.           (progn
  259.         (aset plane-info ALTITUDE 0)
  260.         (aset plane-info ALT-CHANGE 1)
  261.         (atc-update-waiting-list))
  262.         (aset plane-info ALT-CHANGE (int-to-string atc-arg))))
  263.      ((= atc-command ?L)        ; Left turn.
  264.       (aset plane-info DIR-CHANGE atc-arg))
  265.      ((= atc-command ?R)        ; Right turn.
  266.       (aset plane-info DIR-CHANGE (- atc-arg)))
  267.      ((= atc-command ??)        ; Information.
  268.       (message "Aeroplane %c: from %s to %s."
  269.            (+ atc-plane ?A)
  270.            (atc-describe-place (aref plane-info PROVENANCE))
  271.            (atc-describe-place (aref plane-info DESTINATION)))))
  272.     (aset atc-plane-info atc-plane plane-info))))
  273.   (setq atc-plane nil
  274.     atc-command nil
  275.     atc-arg nil))
  276.  
  277. (defun atc-describe-place (place)
  278.   (if (< place 10)
  279.       (format "area %d/%d" place (% (1+ place) 10))
  280.     (if (= place 10)
  281.     "airport #"
  282.       "airport *")))
  283.  
  284. (defun atc-choose-place ()
  285.   (let ((m (atc-rand 100)))
  286.     (if (< m atc-%-airports)
  287.     (+ 10 (% m 2))
  288.       (atc-rand 10))))
  289.  
  290. (defun atc-start-a-plane ()
  291.   (setq atc-moves-since-last-start 0)
  292.   (let ((prov -1)
  293.     (dest -1))
  294.     (while (= prov dest)
  295.       (setq prov (atc-choose-place)
  296.             dest (if (atc-area-p prov)
  297.              (+ 10 (atc-rand 2)) ; An airport: we're disallowing the
  298.            (atc-choose-place)))) ; possibility of area to area.
  299.     (if (atc-area-p prov)
  300.     (let ((symprov (% prov 5))
  301.           x y u v a plane-info)
  302.       (cond
  303.        ((= symprov 0)
  304.         (setq x (+ 1 (atc-rand 7))
  305.           y 0
  306.           u (atc-rand 2)
  307.           v 1))
  308.        ((= symprov 1)
  309.         (setq x (+ 9 (atc-rand 8))
  310.           y 0
  311.           u (1- (atc-rand 3))
  312.           v 1))
  313.        ((= symprov 2)
  314.         (setq n (atc-rand 8)
  315.           x (if (<= n 2) (- 20 n) 20)
  316.           y (if (<= n 2) 0 (- n 2))
  317.           u (1- (atc-rand 2))
  318.           v (- 1 (atc-rand (- 1 u)))))
  319.        ((= symprov 3)
  320.         (setq x 20
  321.           y (+ 7 (atc-rand 6))
  322.           u -1
  323.           v (1- (atc-rand 3))))
  324.        ((= symprov 4)
  325.         (setq x 20
  326.           y (+ 14 (atc-rand 6))
  327.           u -1
  328.           v (1- (atc-rand 2)))))
  329.       (if (/= prov symprov)        ; Rotational symmetry, order 2.
  330.           (setq x (- 20 x)
  331.             y (- 20 y)
  332.             u (- u)
  333.             v (- v)))
  334.       (setq a (+ 5 (atc-rand 5))
  335.         plane-info (vector x y u v a 'nil 'nil prov dest)
  336.         atc-last-plane (1+ atc-last-plane))
  337.       (aset atc-plane-info atc-last-plane plane-info)
  338.       (atc-draw-plane atc-last-plane))
  339.       (let ((plane-info (if (= prov 10)
  340.                 (vector 10 10 -1 0 -1 'nil 'nil prov dest)
  341.               (vector 12 4 -1 -1 -1 'nil 'nil prov dest))))
  342.     (setq atc-last-plane (1+ atc-last-plane))
  343.     (aset atc-plane-info atc-last-plane plane-info)
  344.     (atc-update-waiting-list)))))
  345.  
  346. (defun atc-draw-all-planes ()
  347.   (let ((i atc-first-plane)
  348.     a)
  349.     (while (<= i atc-last-plane)
  350.       (setq a (aref (aref atc-plane-info i) ALTITUDE))
  351.       (if (and a (>= a 0))
  352.       (atc-draw-plane i))
  353.       (setq i (1+ i)))))
  354.  
  355. (defun atc-draw-plane (plane)
  356.   (let ((plane-info (aref atc-plane-info plane)))
  357.     (atc-move-to (aref plane-info X) (aref plane-info Y))
  358.     (if (looking-at (regexp-quote ". "))
  359.     (progn
  360.       (delete-char 2)
  361.       (insert (+ ?A plane) (+ ?0 (aref plane-info ALTITUDE)))))))
  362.  
  363. (defun atc-erase-plane (plane)
  364.   (let ((plane-info (aref atc-plane-info plane)))
  365.     (atc-move-to (aref plane-info X) (aref plane-info Y))
  366.     (if (looking-at "[A-Z][0-9]")
  367.     (progn
  368.       (delete-char 2)
  369.       (insert ?. ? )))))
  370.  
  371. (defun atc-move-to (x y)
  372.   (goto-char (point-min))
  373.   (forward-line (+ 1 y))
  374.   (forward-char (+ 1 (* 2 x))))
  375.     
  376. (defun atc-airport-p (place)
  377.   (or (= place 10) (= place 11)))
  378.  
  379. (defun atc-area-p (place)
  380.   (not (atc-airport-p place)))
  381.  
  382. (defun atc-rand (num)
  383.   "Returns a random number in the range 0 to NUM - 1."
  384.   (% (+ num (% (random) num)) num))
  385.  
  386. (defun atc-insert-board ()
  387.   (interactive)
  388.   (insert (format "
  389.  0 . . . . . . . 1 . . . . . . . . 2 . . .  Air Traffic Control
  390.  . . . . . . . . . . . . . . . . . . . . .  -------------------
  391.  . . . . . . . . . . . . . . . . . . . . . 
  392.  . . . . . . . . . . . . . . . . . . . . .  atc-nb-planes = %d
  393.  . . . . . . . . . . . . * . . . . . . . .  atc-initial-delay = %d
  394.  . . . . . . . . . . . . . . . . . . . . .  atc-acceleration = %d
  395.  . . . . . . . . . . . . . . . . . . . . 3  atc-%%-airports = %d
  396.  9 . . . . . . . . . . . . . . . . . . . .  atc-mean-separation = %d
  397.  . . . . . . . . . . . . . . . . . . . . . 
  398.  . . . . . . . . . . . . . . . . . . . . . 
  399.  . . . . . . . . . . # . . . . . . . . . .  Awaiting Take Off (Max 5)
  400.  . . . . . . . . . . . . . . . . . . . . .  -------------------------
  401.  . . . $ . . . . . . . . . . . . . . . . . 
  402.  . . . . . . . . . . . . . . . . . . . . 4 
  403.  8 . . . . . . . . . . . . . . . . . . . . 
  404.  . . . . . . . . . . . . . . . . . . . . . 
  405.  . . . . . . . . . . . . . . . . $ . . . . 
  406.  . . . . . . . . . . . . . . . . . . . . . 
  407.  . . . . . . . . . . . . . . . . . . . . . 
  408.  . . . . . . . . . . . . . . . . . . . . . 
  409.  . . . 7 . . . . . . . . 6 . . . . . . . 5 "
  410.           atc-nb-planes
  411.           atc-initial-delay
  412.           atc-acceleration
  413.           atc-%-airports
  414.           atc-mean-separation)))
  415.  
  416. (defun atc-update-waiting-list ()
  417.   (let ((i 0)
  418.     (n 0)
  419.     plane-info)
  420.     (while (<= i atc-last-plane)
  421.       (setq plane-info (aref atc-plane-info i)
  422.         a (aref plane-info ALTITUDE))
  423.       (if (and a (= a -1))
  424.       (progn
  425.         (setq n (1+ n))
  426.         (atc-move-to 20 (+ n 12))
  427.         (forward-char 2)
  428.         (or (eolp)
  429.         (kill-line nil))
  430.         (insert (format " %c : %s"
  431.                 (+ i ?A)
  432.                 (atc-describe-place (aref plane-info
  433.                               PROVENANCE))))))
  434.       (setq i (1+ i)))
  435.     (atc-move-to 20 (+ n 13))
  436.     (forward-char 2)
  437.     (or (eolp)
  438.     (kill-line nil))
  439.     (if (> n 5)
  440.     (throw 'stop-game "Airport hold-up!
  441. The number of aeroplanes awaiting take off at any one time
  442. must be kept at five or less."))))
  443.  
  444. (defun atc-move-planes ()
  445.   (interactive)
  446.   (let ((i atc-first-plane)
  447.     plane-info nx ny u v)
  448.     (while (<= i atc-last-plane)
  449.       (setq plane-info (aref atc-plane-info i)
  450.         a (aref plane-info ALTITUDE))
  451.       (if (or (null a) (= a -1))
  452.       nil
  453.     (atc-erase-plane i)
  454.     (setq u (aref plane-info U)
  455.           v (aref plane-info V)
  456.           nx (+ (aref plane-info X) u)
  457.           ny (+ (aref plane-info Y) v)
  458.           dch (aref plane-info DIR-CHANGE)
  459.           ach (aref plane-info ALT-CHANGE))
  460.     (aset plane-info X nx)
  461.     (aset plane-info Y ny)
  462.     (if dch
  463.         (let ((nu u) (nv v))
  464.           (cond
  465.            ((> dch 0)        ; Turning left.
  466.         (setq dch (1- dch)
  467.               nu (sgn (+ v u))
  468.               nv (sgn (- v u))))
  469.            ((< dch 0)        ; Turning right.
  470.         (setq dch (1+ dch)
  471.               nu (sgn (- u v))
  472.               nv (sgn (+ u v)))))
  473.           (if (= dch 0) (setq dch nil)) ; Finished turn.
  474.           (aset plane-info U nu)
  475.           (aset plane-info V nv)
  476.           (aset plane-info DIR-CHANGE dch)))
  477.     (if ach
  478.         (if (stringp ach)
  479.         (aset plane-info ALT-CHANGE (string-to-int ach))
  480.           (let ((a (aref plane-info ALTITUDE)))
  481.         (setq a (+ a (sgn (- ach a))))
  482.         (aset plane-info ALTITUDE a)
  483.         (setq ach (1+ (* 2 (/ ach 2))))
  484.         (if (= ach a)
  485.             (aset plane-info ALT-CHANGE nil)
  486.           (aset plane-info ALT-CHANGE ach))
  487.         (if (= a 0)
  488.             (progn
  489.               (atc-check-landing i plane-info nx ny)
  490.               (aset plane-info ALTITUDE nil))))))
  491.     (if (and (>= nx 0)
  492.          (<= nx 20)
  493.          (>= ny 0)
  494.          (<= ny 20))
  495.         nil
  496.       (atc-check-exit i plane-info nx ny)
  497.       (aset plane-info ALTITUDE nil)
  498.       (atc-update-first-plane i))
  499.     (aset atc-plane-info i plane-info)
  500.     (if (aref plane-info ALTITUDE) 
  501.         (atc-draw-plane i)))
  502.       (setq i (1+ i))))
  503.   (goto-char (point-min)))
  504.  
  505. (defun atc-update-first-plane (i)
  506.   (if (= i atc-first-plane)
  507.       (progn
  508.     (setq atc-first-plane (1+ atc-first-plane))
  509.     (while (and (<= atc-first-plane atc-last-plane)
  510.             (null (aref (aref atc-plane-info atc-first-plane)
  511.                 ALTITUDE)))
  512.       (setq atc-first-plane (1+ atc-first-plane)))))
  513.   (if (= atc-first-plane atc-nb-planes)
  514.       (throw 'stop-game "Congratulations!
  515. You have been a great success as an Air Traffic Controller.
  516. If we had more people like you, air travel would be a lot safer.")))
  517.  
  518. (defun atc-check-landing (i plane-info nx ny)
  519.   (let ((dest (aref plane-info DESTINATION)))
  520.     (cond
  521.      ((and (= nx 10)            ; Attempt to land at #.
  522.        (= ny 10))
  523.       (if (and (= (aref plane-info U) -1) ; Correct direction ?
  524.            (= (aref plane-info V) 0))
  525.       (if (= dest 10)        ; Correct airport ?
  526.           (atc-update-first-plane i)
  527.         (atc-wrong-airport 10 11))
  528.     (atc-wrong-dir-landing i
  529.                    (aref plane-info U)
  530.                    (aref plane-info V)
  531.                    10)))
  532.      ((and (= nx 12)            ; Attempt to land at *.
  533.        (= ny 4))
  534.       (if (and (= (aref plane-info U) -1) ; Correct direction ?
  535.            (= (aref plane-info V) -1))
  536.       (if (= dest 11)        ; Correct airport ?
  537.           (atc-update-first-plane i)
  538.         (atc-wrong-airport 11 10))
  539.     (atc-wrong-dir-landing i 
  540.                    (aref plane-info U)
  541.                    (aref plane-info V)
  542.                    11)))
  543.      (t
  544.       (atc-bad-landing i (aref plane-info X) (aref plane-info Y))))))
  545.  
  546. (defun atc-wrong-airport (practice theory)
  547.   (throw 'stop-game
  548.      (format "Wrong airport!
  549. Aeroplane %c just landed safely at %s.
  550. Unfortunately, it was scheduled to arrive at %s!"
  551.          (+ ?A i)
  552.          (atc-describe-place practice)
  553.          (atc-describe-place theory))))
  554.  
  555. (defun atc-check-exit (i plane-info nx ny)
  556.   (let ((dest (aref plane-info DESTINATION)))
  557.     (if (atc-airport-p dest)
  558.     (throw 'stop-game 
  559.            (format "Lost aeroplane!
  560. Aeroplane %c was meant to be landing at %s,
  561. not leaving your airspace."
  562.                (+ i ?A)
  563.                (atc-describe-place dest)))
  564.       (if (< (aref plane-info ALTITUDE) 5)
  565.       (throw 'stop-game
  566.          (format "Flying at dangerously low altitude!
  567. Aeroplane %c just left your airspace at altitude %d.
  568. All planes must achieve at least altitude 5 in open airspace."
  569.              (+ i ?A)
  570.              (aref plane-info ALTITUDE)))
  571.     (cond
  572.      ((= nx -1)
  573.       (if (not (memq dest (list 7 8 9 0)))
  574.           (atc-v-bad-direction i dest)
  575.         (cond
  576.          ((= dest 7)
  577.           (if (or (< ny 14) (> ny 21))
  578.           (atc-bad-direction i dest)))
  579.          ((= dest 8)
  580.           (if (or (< ny 7) (> ny 14))
  581.           (atc-bad-direction i dest)))
  582.          ((= dest 9)
  583.           (if (> ny 7)
  584.           (atc-bad-direction i dest)))
  585.          ((= dest 0)
  586.           (if (> ny -1)
  587.           (atc-bad-direction i dest))))))
  588.      ((= ny -1)
  589.       (if (not (memq dest (list 9 0 1 2)))
  590.           (atc-v-bad-direction i dest)
  591.         (cond
  592.          ((= dest 9)
  593.           (if (> nx -1)
  594.           (atc-bad-direction i dest)))
  595.          ((= dest 0)
  596.           (if (> nx 8)
  597.           (atc-bad-direction i dest)))
  598.          ((= dest 1)
  599.           (if (or (< nx 8) (> nx 17))
  600.           (atc-bad-direction i dest)))
  601.          ((= dest 2)
  602.           (if (< nx 17)
  603.           (atc-bad-direction i dest))))))
  604.      ((= nx 21)
  605.       (if (not (memq dest (list 2 3 4 5)))
  606.           (atc-v-bad-direction i dest)
  607.         (cond
  608.          ((= dest 2)
  609.           (if (> ny 6)
  610.           (atc-bad-direction i dest)))
  611.          ((= dest 3)
  612.           (if (or (< ny 6) (> ny 13))
  613.           (atc-bad-direction i dest)))
  614.          ((= dest 4)
  615.           (if (< ny 13)
  616.           (atc-bad-direction i dest)))
  617.          ((= dest 5)
  618.           (if (< ny 21)
  619.           (atc-bad-direction i dest))))))
  620.      ((= ny 21)
  621.       (if (not (memq dest (list 4 5 6 7)))
  622.           (atc-v-bad-direction i dest)
  623.         (cond
  624.          ((= dest 4)
  625.           (if (< nx 21)
  626.           (atc-bad-direction i)))
  627.          ((= dest 5)
  628.           (if (< nx 12)
  629.           (atc-bad-direction i)))
  630.          ((= dest 6)
  631.           (if (or (< nx 3) (> nx 12))
  632.           (atc-bad-direction i)))
  633.          ((= dest 7)
  634.           (if (> nx 3)
  635.           (atc-bad-direction i)))))))))))
  636.  
  637. (defun atc-bad-direction (i area)
  638.   (throw 'stop-game
  639.      (format "Incorrect direction!
  640. Aeroplane %c should have left in the direction %d/%d."
  641.          (+ i ?A)
  642.          area (% (1+ area) 10))))
  643.  
  644. (defun atc-v-bad-direction (i area)
  645.   (throw 'stop-game
  646.      (format "Wildly incorrect direction!
  647. Aeroplane %c should have left in the direction %d/%d.
  648. You have instructed it to fly miles off course!"
  649.          (+ i ?A)
  650.          area (% (1+ area) 10))))
  651.  
  652. (defun atc-bad-landing (i x y)
  653.   (throw 'stop-game
  654.      (format "Crash landing!
  655. Aeroplane %c just crashed in the middle of nowhere (%d,%d),
  656. following your instructions to reduce altitude to zero."
  657.          (+ i ?A)
  658.          x y)))
  659.  
  660. (defun atc-wrong-dir-landing (i u v place)
  661.   (throw 'stop-game
  662.      (format "Landing in the wrong direction!
  663. Aeroplane %c just tried to land in direction (%d,%d)
  664. and so destroyed several airport buildings.
  665. %s is designed for landing in the direction (-1,%d)."
  666.          (+ i ?A)
  667.          u v
  668.          (capitalize (atc-describe-place place))
  669.          (if (= place 10) 0 -1))))
  670.  
  671. (defun atc-check-crashes ()
  672.   (let ((i atc-first-plane)
  673.     j 
  674.     info1
  675.     info2
  676.     alt1
  677.     alt2)
  678.     (while (< i atc-last-plane)
  679.       (setq info1 (aref atc-plane-info i))
  680.       (if (and (setq alt1 (aref info1 ALTITUDE))
  681.            (> alt1 0))
  682.       (progn
  683.         (setq j (1+ i))
  684.         (while (<= j atc-last-plane)
  685.           (setq info2 (aref atc-plane-info j))
  686.           (and (setq alt2 (aref info2 ALTITUDE))
  687.            (> alt2 0)
  688.            (= alt1 alt2)
  689.            (= (aref info1 X) (aref info2 X))
  690.            (= (aref info1 Y) (aref info2 Y))
  691.            (atc-crash i j (aref info1 X) (aref info1 Y)))
  692.           (setq j (1+ j)))))
  693.       (setq i (1+ i)))))
  694.  
  695. (defun atc-crash (i j x y)
  696.   (throw 'stop-game (format "Mid-air crash!
  697. Aeroplanes %c and %c just crashed at grid location (%d,%d)."
  698.                 (+ i ?A)
  699.                 (+ j ?A)
  700.                 x y)))
  701.  
  702. (defun sgn (n)
  703.   "Returns the sign of N, i.e. 1 if N is positive,
  704. -1 if N is negative, 0 if N is zero."
  705.   (cond ((> n 0) 1)
  706.     ((< n 0) -1)
  707.     (t 0)))
  708.  
  709. ;----------1.5cm seam allowance not included--------------------
  710.