-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathrooms.lisp
171 lines (155 loc) · 6.09 KB
/
rooms.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
;;;; Draw the nine rooms on the screen
;;;; @(#)rooms.c 3.8 (Berkeley) 6/15/81
(in-package :cl-rogue)
(defun do-rooms()
;; bsze is the maximum room size
;; TODO: I'm limiting to 80x24 here because I'm not sure
;; if this code works at bigger sizes.
(let*
((max-cols (min 80 cl-charms/low-level:*cols*))
(max-lines (min 24 cl-charms/low-level:*lines*))
(bsze (make-coord :x (truncate (/ max-cols
3))
:y (truncate (/ max-lines
3)))))
;; Clear things for a new level
(map nil
#'(lambda (rp)
(zero! (moor-r-goldval rp)
(moor-r-nexits rp)
(moor-r-flags rp)))
rooms)
;; Put the gone rooms, if any, on the level
(loop repeat (rnd 4)
do (logior! (moor-r-flags (aref rooms (rnd-room)))
ISGONE))
;; Dig and populate all the rooms on the level
(dotimes (i MAXROOMS)
(block :continue
(let ((rp (aref rooms i))
(top (make-coord :x (1+ (* (mod i 3)
(coord-x bsze)))
:y (* (truncate (/ i 3))
(coord-y bsze)))))
;; Find upper left corner of box that this room goes in.
(when (logtest (moor-r-flags rp) ISGONE)
;; Place a gone room. Make certain that there is a
;; blank line for passage drawing.
(loop
(setf
(coord-x (moor-r-pos rp)) (+ (coord-x top)
(rnd (- (coord-x bsze)
2))
1)
(coord-y (moor-r-pos rp)) (+ (coord-y top)
(rnd (- (coord-y bsze)
2))
1)
(coord-x (moor-r-max rp)) (- max-cols)
(coord-y (moor-r-max rp)) (- max-lines))
(when (and (plusp (coord-y (moor-r-pos rp)))
(< (coord-y (moor-r-pos rp))
(1- max-lines)))
(return)))
(return-from :continue))
(when (< (rnd 10) (1- level))
(logior! (moor-r-flags rp) ISDARK))
;; Find a place and size for a random room
(loop
(setf
(coord-x (moor-r-max rp)) (+ (rnd (- (coord-x bsze) 4))
4)
(coord-y (moor-r-max rp)) (+ (rnd (- (coord-y bsze) 4))
4)
(coord-x (moor-r-pos rp)) (+ (coord-x top)
(rnd (- (coord-x bsze)
(coord-x (moor-r-max rp)))))
(coord-y (moor-r-pos rp)) (+ (coord-y top)
(rnd (- (coord-y bsze)
(coord-y (moor-r-max rp))))))
(unless (zerop (coord-y (moor-r-pos rp)))
(return)))
;; Put the gold in
(when (and (< (rnd 100) 50)
(or (not *amulet*)
(>= level max-level)))
(setf (moor-r-goldval rp) (goldcalc))
(rnd-pos rp (moor-r-gold rp))
(when (not (eq (roomin (moor-r-gold rp)) rp))
(rogue-done)))
(draw-room rp)
;; Put the monster in
(when (< (rnd 100)
(if (plusp (moor-r-goldval rp)) 80 25))
(let ((tp (make-thing))
(mp (make-coord)))
(loop
(rnd-pos rp mp)
(when (eq (rogue-mvwinch cl-charms/low-level:*stdscr*
(coord-y mp)
(coord-x mp))
THE-FLOOR)
(return)))
(new-monster tp (randmonster nil) mp)
;; See if we want to give it a treasure to carry around.
(when (< (rnd 100)
(monster-m-carry (char-monster (thing-t-type tp))))
(attach (thing-t-pack tp) (new-thing))))))))))
(defun rpy (rp)
(coord-y (moor-r-pos rp)))
(defun rpx (rp)
(coord-x (moor-r-pos rp)))
(defun rmy (rp)
(coord-y (moor-r-max rp)))
(defun rmx (rp)
(coord-x (moor-r-max rp)))
(defun draw-room (rp)
"Draw a box around a room."
(let ((py (rpy rp))
(px (rpx rp))
(my (rmy rp))
(mx (rmx rp)))
(cl-charms/low-level:move py
(1+ px))
(vert (- my 2)) ; Draw left side
(cl-charms/low-level:move (1- (+ py my))
px)
(horiz mx) ; Draw bottom
(cl-charms/low-level:move py px)
(horiz mx) ; Draw top
(vert (- my 2)) ; Draw right side
;; Put the floor down
(do ((j 1 (1+ j)))
((>= j (1- my)))
(cl-charms/low-level:move (+ py j) (1+ px))
(do ((k 1 (1+ k)))
((>= k (1- mx)))
(rogue-addch THE-FLOOR)))
;; Put the gold there
(when (plusp (moor-r-goldval rp))
(rogue-mvaddch (coord-y (moor-r-gold rp))
(coord-x (moor-r-gold rp))
GOLD))))
(defun horiz (cnt)
"Draw a horizontal line."
(dotimes (_ cnt)
(rogue-addch #\-)))
(defun vert (cnt)
"Draw a vertical line."
(let (x y)
(cl-charms/low-level:getyx cl-charms/low-level:*stdscr* y x)
(decf x)
(dotimes (_ cnt)
(cl-charms/low-level:move (incf y) x)
(rogue-addch #\|))))
(defun rnd-pos (rp cp)
"Pick a random spot in a room."
(setf
(coord-x cp) (+ (coord-x (moor-r-pos rp))
(rnd (- (coord-x (moor-r-max rp))
2))
1)
(coord-y cp) (+ (coord-y (moor-r-pos rp))
(rnd (- (coord-y (moor-r-max rp))
2))
1)))