-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathrogue.lisp
484 lines (410 loc) · 12.4 KB
/
rogue.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
;;;; Rogue definitions and variable declarations
;;;; @(#)rogue.h 3.38 (Berkeley) 6/15/81
(in-package :cl-rogue)
;;; Maximum number of different things
(defconstant MAXROOMS 9)
(defconstant MAXTHINGS 9)
(defconstant MAXOBJ 9)
(defconstant MAXPACK 23)
(defconstant MAXTRAPS 10)
(defconstant NUMTHINGS 7) ; number of types of things (scrolls, rings, etc.)
;;; Return values for get functions
(defconstant NORM 0) ; normal exit
(defconstant QUIT 1) ; quit option setting
(defconstant MINUS 2) ; back up one option
;;; Things that appear on the screens
(defconstant PASSAGE #\#)
(defconstant DOOR #\+)
(defconstant THE-FLOOR #\.)
(defconstant PLAYER #\@)
(defconstant TRAP #\^)
(defconstant TRAPDOOR #\>)
(defconstant ARROWTRAP #\{)
(defconstant SLEEPTRAP #\$)
(defconstant BEARTRAP #\})
(defconstant TELTRAP #\~)
(defconstant DARTTRAP #\`)
(defconstant SECRETDOOR #\&)
(defconstant STAIRS #\%)
(defconstant GOLD #\*)
(defconstant POTION #\!)
(defconstant SCROLL #\?)
(defconstant MAGIC #\$)
(defconstant FOOD #\:)
(defconstant WEAPON #\))
(defconstant ARMOR #\])
(defconstant AMULET #\,)
(defconstant RING #\=)
(defconstant STICK #\/)
(defconstant CALLABLE #\-)
;;; Various constants
(defparameter PASSWD "mTwA0qqnrlXTw")
(defconstant BEARTIME 3)
(defconstant SLEEPTIME 5)
(defconstant HEALTIME 30)
(defconstant HOLDTIME 2)
(defconstant STPOS 0)
(defconstant WANDERTIME 70)
(defconstant BEFORE 1)
(defconstant AFTER 2)
(defconstant HUHDURATION 20)
(defconstant SEEDURATION 850)
(defconstant HUNGERTIME 1300)
(defconstant MORETIME 150)
(defconstant STOMACHSIZE 2000)
(defconstant ESCAPE 27)
(defconstant LEFT 0)
(defconstant RIGHT 1)
(defconstant BOLT-LENGTH 6)
;;; Save against things
(defconstant VS-POISON #o00)
(defconstant VS-PARALYZATION #o00)
(defconstant VS-DEATH #o00)
(defconstant VS-PETRIFICATION #o01)
(defconstant VS-BREATH #o02)
(defconstant VS-MAGIC #o03)
;;; Various flag bits
(defconstant ISDARK #o0000001)
(defconstant ISCURSED #o000001)
(defconstant ISBLIND #o0000001)
(defconstant ISGONE #o0000002)
(defconstant ISKNOW #o0000002)
(defconstant ISRUN #o0000004)
(defconstant ISFOUND #o0000010)
(defconstant ISINVIS #o0000020)
(defconstant ISMEAN #o0000040)
(defconstant ISGREED #o0000100)
(defconstant ISBLOCK #o0000200)
(defconstant ISHELD #o0000400)
(defconstant ISHUH #o0001000)
(defconstant ISREGEN #o0002000)
(defconstant CANHUH #o0004000)
(defconstant CANSEE #o0010000)
(defconstant ISMISL #o0020000)
(defconstant ISCANC #o0020000)
(defconstant ISMANY #o0040000)
(defconstant ISSLOW #o0040000)
(defconstant ISHASTE #o0100000)
;;; Potion types
(defconstant P-CONFUSE 0)
(defconstant P-PARALYZE 1)
(defconstant P-POISON 2)
(defconstant P-STRENGTH 3)
(defconstant P-SEEINVIS 4)
(defconstant P-HEALING 5)
(defconstant P-MFIND 6)
(defconstant P-TFIND 7)
(defconstant P-RAISE 8)
(defconstant P-XHEAL 9)
(defconstant P-HASTE 10)
(defconstant P-RESTORE 11)
(defconstant P-BLIND 12)
(defconstant P-NOP 13)
(defconstant MAXPOTIONS 14)
;;; Scroll types
(defconstant S-CONFUSE 0)
(defconstant S-MAP 1)
(defconstant S-LIGHT 2)
(defconstant S-HOLD 3)
(defconstant S-SLEEP 4)
(defconstant S-ARMOR 5)
(defconstant S-IDENT 6)
(defconstant S-SCARE 7)
(defconstant S-GFIND 8)
(defconstant S-TELEP 9)
(defconstant S-ENCH 10)
(defconstant S-CREATE 11)
(defconstant S-REMOVE 12)
(defconstant S-AGGR 13)
(defconstant S-NOP 14)
(defconstant S-GENOCIDE 15)
(defconstant MAXSCROLLS 16)
;;; Weapon types
(defconstant MACE 0)
(defconstant SWORD 1)
(defconstant BOW 2)
(defconstant ARROW 3)
(defconstant DAGGER 4)
(defconstant ROCK 5)
(defconstant TWOSWORD 6)
(defconstant SLING 7)
(defconstant DART 8)
(defconstant CROSSBOW 9)
(defconstant BOLT 10)
(defconstant SPEAR 11)
(defconstant MAXWEAPONS 12)
;;; Armor types
(defconstant LEATHER 0)
(defconstant RING-MAIL 1)
(defconstant STUDDED-LEATHER 2)
(defconstant SCALE-MAIL 3)
(defconstant CHAIN-MAIL 4)
(defconstant SPLINT-MAIL 5)
(defconstant BANDED-MAIL 6)
(defconstant PLATE-MAIL 7)
(defconstant MAXARMORS 8)
;;; Ring types
(defconstant R-PROTECT 0)
(defconstant R-ADDSTR 1)
(defconstant R-SUSTSTR 2)
(defconstant R-SEARCH 3)
(defconstant R-SEEINVIS 4)
(defconstant R-NOP 5)
(defconstant R-AGGR 6)
(defconstant R-ADDHIT 7)
(defconstant R-ADDDAM 8)
(defconstant R-REGEN 9)
(defconstant R-DIGEST 10)
(defconstant R-TELEPORT 11)
(defconstant R-STEALTH 12)
(defconstant MAXRINGS 13)
;;; Rod/Wand/Staff types
(defconstant WS-LIGHT 0)
(defconstant WS-HIT 1)
(defconstant WS-ELECT 2)
(defconstant WS-FIRE 3)
(defconstant WS-COLD 4)
(defconstant WS-POLYMORPH 5)
(defconstant WS-MISSILE 6)
(defconstant WS-HASTE-M 7)
(defconstant WS-SLOW-M 8)
(defconstant WS-DRAIN 9)
(defconstant WS-NOP 10)
(defconstant WS-TELAWAY 11)
(defconstant WS-TELTO 12)
(defconstant WS-CANCEL 13)
(defconstant MAXSTICKS 14)
;;; All the fun defines
(defmacro detach (list item)
"Takes an item out of whatever linked list it might be in."
`(setf ,list (remove ,item ,list :test #'eql)))
(defmacro attach (list item)
"Add an item to the head of a list."
`(push ,item ,list))
(defun inroom (rp cp)
(and (<= (coord-x cp) (+ (coord-x (moor-r-pos rp)) (1- (coord-x (moor-r-max rp)))))
(<= (coord-x (moor-r-pos rp)) (coord-x cp))
(<= (coord-y cp) (+ (coord-y (moor-r-pos rp)) (1- (coord-y (moor-r-max rp)))))
(<= (coord-y (moor-r-pos rp)) (coord-y cp))))
(defun winat (y x)
(if (eql (rogue-mvwinch mw y x) #\Space)
(rogue-mvwinch cl-charms/low-level:*stdscr* y x)
(rogue-winch mw)))
(defun rogue-debug (&rest args)
;; (apply #'error args))
;; (when wizard (apply #'msg args)))
(apply #'msg args))
(defun cmov (xy)
(cl-charms/low-level:move (coord-y xy)
(coord-x xy)))
(defun distance (y1 x1 y2 x2)
(+ (* (- x2 x1)
(- x2 x1))
(* (- y2 y1)
(- y2 y1))))
(defun draw (window)
(cl-charms/low-level:wrefresh window))
(define-symbol-macro hero.x (coord-x (thing-t-pos *player*)))
(define-symbol-macro hero.y (coord-y (thing-t-pos *player*)))
(define-symbol-macro hero (thing-t-pos *player*))
(define-symbol-macro pstats (thing-t-stats *player*))
(define-symbol-macro pack (thing-t-pack *player*))
(defun on (thing flag)
(logtest (thing-t-flags thing) flag))
(defun off (thing flag)
(not (on thing flag)))
(defun goldcalc ()
(+ (rnd (+ 50
(* 10 level)))
2))
(defun isring (h r)
(and
(not (null (aref cur-ring h)))
(equal (object-o-which (aref cur-ring h)) r)))
(defun iswearing (r)
(or (isring LEFT r)
(isring RIGHT r)))
(defun newgrp ()
(incf group))
(defmacro object-o-charges (o)
`(object-o-ac ,o))
(defun ismult (type)
(or (equal type POTION)
(equal type SCROLL)
(equal type FOOD)))
;;; Moved here from main.lisp
(defun rnd (range)
"Pick a very random number."
(case range
(0 0)
(otherwise (random range))))
;;; Now we define the structures and types
(defstruct coord
"Coordinate data type"
(x 0 :type fixnum)
(y 0 :type fixnum))
(defstruct str-t
(st-str 0 :type fixnum)
(st-add 0 :type fixnum))
(defstruct magic-item
"Stuff about magic items"
(mi-name "" :type string)
(mi-prob 0 :type fixnum)
(mi-worth 0 :type fixnum))
(defstruct moor
"Room structure"
(r-pos (make-coord) :type coord)
(r-max (make-coord) :type coord)
(r-gold (make-coord) :type coord)
(r-goldval 0 :type fixnum)
(r-flags 0 :type fixnum)
(r-nexits 0 :type fixnum)
;; The following sucks, you have to initialize manually to a fresh
;; array of coords. Fortunately that's only in one place.
r-exit)
(defstruct rogue-trap
"Array of all traps on this level"
(tr-pos (make-coord) :type coord)
(tr-type #\Nul :type character)
(tr-flags 0 :type fixnum))
(defstruct stats
"Structure describing a fighting being"
(s-str (make-str-t) :type str-t)
(s-exp 0 :type integer)
(s-lvl 0 :type fixnum)
(s-arm 0 :type fixnum)
(s-hpt 0 :type fixnum)
(s-dmg "" :type string))
(defstruct thing
"Structure for monsters and player"
(t-pos (make-coord) :type coord)
(t-turn nil :type boolean)
(t-type #\Nul :type character)
(t-disguise #\Nul :type character)
(t-oldch #\Nul :type character)
(t-dest (make-coord) :type coord)
(t-flags 0 :type fixnum)
(t-stats (make-stats) :type stats)
(t-pack (list))
(t-reserved 0 :type fixnum))
(defstruct monster
"Array containing information on all the various types of mosnters"
(m-name "" :type string) ; What to call the monster
(m-carry 0 :type fixnum) ; Probability of carrying something
(m-flags 0 :type fixnum) ; Things about the monster
(m-stats (make-stats) :type stats)) ; Initial stats
(defstruct object
"Structure for a thing that the rogue can carry"
(o-type #\Nul :type character) ; What kind of object it is
(o-pos (make-coord) :type coord)
(o-launch 100 :type fixnum) ; "o-which" needed to launch it, 100 == impossible
(o-damage "" :type string)
(o-hurldmg "" :type string)
(o-count 0 :type fixnum)
(o-which 0 :type fixnum)
(o-hplus 0 :type fixnum)
(o-dplus 0 :type fixnum)
(o-ac 0 :type fixnum)
(o-flags 0 :type fixnum)
(o-group 0 :type fixnum))
(defstruct words
(w-string "" :type string))
(defconstant NCOLORS 24)
(defconstant NSYLLS 159)
(defconstant NSTONES 20)
(defconstant NWOOD 22)
(defconstant NMETAL 11)
;;; Utilities
;;; From onlisp.lisp
(defmacro for ((var start stop) &body body)
(let ((gstop (gensym)))
`(do ((,var ,start (1+ ,var))
(,gstop ,stop))
((> ,var ,gstop))
,@body)))
(defmacro while (test &body body)
`(do ()
((not ,test))
,@body))
(defmacro when-let ((var value) &body body)
"Evaluate VALUE, and if the result is non-nil bind it to VAR
and evaluate BODY."
`(let ((,var ,value))
(when ,var ,@body)))
;;; From the 'net
(defun shuffle-vector! (result)
"Destructively shuffle elements in a vector like a deck of
cards."
(loop
finally (return result)
for i from (length result) downto 1
as j = (random i)
do (rotatef (svref result j) (svref result (1- i)))))
(defun shuffle-vector (v)
"Return copy of vector with elements shuffled like a deck of
cards."
(shuffle-vector! (copy-seq v)))
(defun onep (n)
(and (numberp n) (= n 1)))
;;; Misc
(defmacro verbose (&body body)
`(unless terse ,@body))
(defun nonzerop (n)
(and (numberp n) (not (zerop n))))
(defmacro logior! (place &rest integers)
"Like C's |= operator."
`(setf ,place (logior ,place ,@integers)))
(defmacro logclr! (place integer)
"Destructively clear a bit."
`(setf ,place (logand ,place (lognot ,integer))))
(defmacro zero! (&rest places)
(let ((zeroed-places
(mapcan #'(lambda (&rest args) args)
places
(make-list (length places) :initial-element 0))))
`(setf ,@zeroed-places)))
;; Really should come from cl-charms/low-level
(defun ctrl (ch)
(code-char (logand (char-int ch) #o37)))
(defun unctrl-char (c)
;; XXX: this doesn't actually handle control chars as it should??
;; (I couldn't get cl-ncurses unctrl to work).
(format nil "~:c" c))
(defun >1 (number)
(> number 1))
;; Curses helpers to deal with the fact that curses expects ints, not
;; Lisp chars. TODO: do something more sane here.
(defun rogue-code-char (code)
;; Note this is a total guess as to what to do here
;; TODO: maybe logand with 255 instead?
(if (minusp code)
#\Nul
(code-char code)))
(defun rogue-addch (ch)
(cl-charms/low-level:addch (char-code ch)))
(defun rogue-waddch (win ch)
(cl-charms/low-level:waddch win (char-code ch)))
(defun rogue-mvaddch (y x ch)
(cl-charms/low-level:mvaddch y x (char-code ch)))
(defun rogue-mvwaddch (win y x ch)
(cl-charms/low-level:mvwaddch win y x (char-code ch)))
(defun rogue-winch (win)
(rogue-code-char (cl-charms/low-level:winch win)))
(defun rogue-mvinch (y x)
(rogue-code-char (cl-charms/low-level:mvinch y x)))
(defun rogue-mvwinch (win y x)
(rogue-code-char (cl-charms/low-level:mvwinch win y x)))
(defvar *resettable-symbols* '())
(defun reset-rogue-symbols ()
(dolist (symb *resettable-symbols*)
(setf (symbol-value symb) (funcall (get symb 'resetter)))))
(defmacro define-resettable (var val &optional doc)
`(progn
(setf (get ',var 'resetter) (lambda () ,val))
(defparameter ,var (funcall (get ',var 'resetter)) ,doc)
(pushnew ',var *resettable-symbols*)))
(defun save-resettables (stream)
(dolist (symb *resettable-symbols*)
(format stream "(setf ~a '" (symbol-name symb))
(prin1 (symbol-value symb) stream)
(format stream ")~%~%")))