• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Untitled

a guest May 12th, 2019 93 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. DECLARE SUB piples (h\$)
2. DECLARE SUB cube (s\$(), n1, n2, n3, n4, m\$, m1\$, m2\$)
3. DECLARE SUB sets (s\$, s1\$, n2, mx)
4. DECLARE SUB scrn (s\$, s1\$, n2, ff)
5. DECLARE SUB cph (n1, n2)
6. DECLARE SUB sy (m\$, m1\$, n)
7. DECLARE SUB road (LOC\$(), locx, locy, ddd\$, nn)
8. DECLARE SUB tree (LOC\$(), locx, locy, d\$, n)
9. DECLARE SUB wr (h\$, d\$, x, y)
10. DECLARE SUB hous (h\$, f, r)
11. DECLARE SUB wrh (h\$, find\$, lx, door, fin)
12. DECLARE SUB opr (n, c\$, n1, n2)
13. DECLARE SUB prs (LOC\$(), locx, locy, xx, yy, nx1, nx2, ny1, ny2, posx, posy, x, y, lll, col9)
14. DECLARE SUB sp (n)
15. DECLARE SUB sex (sex1, h1\$, n2\$, sx\$)
16. DECLARE SUB setwr (h\$, n, d\$, n1, n2)
17. DECLARE SUB say (n\$, n1\$, n2\$)
18. DECLARE SUB wrl (u, d, l, r, c, LOC\$(), locx, locy)
19. DECLARE SUB sety (s\$(), s1\$, x, y, n, mx)
20.         RANDOMIZE TIMER
21.         CLEAR 2000000
22.          CLS
23.          col8 = 7
24.         DIM mon\$(12), days(12)
25.         year = 679: mont = 3: day = 22
26.         min = 59: hour = 11: sec = 100
28.         DATA 26,25,26,26,25,26,25,26,26,25,26,26
29.         DATA 3,9,5,10,12,15,13
30.         FOR i = 1 TO 12: READ mon\$(i): NEXT i
31.         FOR i = 1 TO 12: READ days(i): NEXT i
32.         FOR i = 1 TO 7: READ soon(i): NEXT i
33.         sw = 1
34.         SCREEN 0
35.         CLS
36.         NAME\$ = "Jim"
37.         sex1 = 1
38.         GOTO m101
39. locgen: nn1 = 2
40.         locx = 180
41.         locy = 60
42.         DIM LOC\$(locy)
43.         FOR i = 1 TO locx: loc11\$ = loc11\$ + ".": NEXT i
44.         FOR j = 1 TO locy: LOC\$(j) = loc11\$: NEXT j
45.
46.         npip = INT((RND * (locx * locy / 80)) + (locx * locy / 80))
47.         DIM pp\$(npip, 3)
48.         mag = INT(((npip / 8)) / (RND * 2 + 4)) + 2
49.         DIM mg\$(mag, nn1)
50.         taw = INT(npip / 60) + 1
51.         DIM tw(taw, nn1)
52.         hot = INT(((npip / 12)) / (RND * 2 + 5)) + 1
53.         DIM ht\$(hot, nn1)
54.         hos = INT(npip / 4)
55.         DIM hs\$(hos, nn1)
56.         enm = INT(npip * (RND * .5)) + 1
57.         DIM en\$(enm, 2)
58.         itm = INT((npip / 5) * (RND * 2 + 2)) + 1
59.        ' DIM item\$(itm, nn1)
60.         hra = INT(RND * 1.99): IF hra = 1 THEN DIM hram(5)
61.         cas = INT(RND * 1.99): IF cas = 1 THEN DIM casi(5)
62.         kld = INT(npip / (RND * 2 + 8))
63.         DIM kld\$(kld)
64.         IF npip > 150 THEN wall = INT(RND * 1.99) + 4: GOTO wrwall
65.         IF npip > 120 THEN wall = INT(RND * 2.99) + 2: GOTO wrwall
66.         IF npip > 100 THEN wall = INT(RND * 2.99): GOTO wrwall
67.         IF npip > 70 THEN wall = INT(RND * 1.99): GOTO wrwall
68.         GOTO endwr
69.
70. m101:   lll = 0
71.         posx = 1: posy = 1
72.         hp = 20
73.         GOSUB locgen
74.         DATA 2, -1, 5, -1, 7, 1, 10, 1
75.         nx1 = 16: nx2 = 79: ny1 = 4: ny2 = 22
76.
77.         DIM kys(10), pr(20)
78.         s\$ = ".": col = 8
79.         FOR i = 1 TO 20
80.         pr(i) = INT(RND * 100.99): NEXT i
81.         FOR i = 1 TO 4: READ ky1: READ kys(ky1): NEXT i
82.         n\$ = "@"
83. m100:   wsh1 = INT(wsh / 60): wsh2 = (wsh / 60 - wsh1) * 60
84.         zhd1 = INT(zhd / 60): zhd2 = (zhd / 60 - zhd1) * 60
85.         nzet = -1.039: wsh = 462 - nzet: zhd = 1182 + nzet
86.         x = INT(RND * 40) + 26: y = INT(RND * 10) + 9
87.         dd\$ = CHR\$(SCREEN(y, x)): IF dd\$ <> "." THEN GOTO m100
88.         COLOR 15
89.         LOCATE y, x: PRINT n\$
90. ink:    sec = sec + 1: IF sec = 10001 THEN GOSUB status: sec = 1: min1 = min1 + 1: min = min + 1: IF min = 60 THEN min = 0: hour = hour + 1: IF hour = 24 THEN hour = 0: day = day + 1: min1 = 0: min2 = 0: min3 = 0: min4 = 0: min5 = 0: wsh = wsh + nzet: wsh1 = INT(wsh / 60): wsh2 = (wsh / 60 - wsh1) * 60: col8 = 1: zhd = zhd - nzet: zhd1 = INT(zhd / 60): zhd2 = (zhd / 60 - zhd1) * 60: IF day = days(mont) + 1 THEN mont = mont + 1: day = 0: IF mont = 13 THEN mont = 1: year = year + 1
91.         IF hour = wsh1 AND min = INT(wsh2) AND sec = 2 THEN min2 = min1: gg = 1
92.         min3 = min1 - min2: IF min3 / 10 = INT(min3 / 10) AND gg = 1 AND sec = 1 THEN col8 = col8 + 1: GOSUB prscr: IF min3 > 40 THEN gg = 0
93.         IF hour = zhd1 AND min = INT(zhd2) AND sec = 2 THEN min4 = min1: zz = 1
94.         min5 = min1 - min4: IF min5 / 10 = INT(min5 / 10) AND zz = 1 AND sec = 2 THEN col8 = col8 - 1: GOSUB prscr: IF min5 > 40 THEN zz = 0
95.         IF hour = wsh1 + 3 AND min = INT(wsh2) AND sec = 2 THEN col8 = 7: GOSUB prscr
96.         IF hour = zhd1 + 2 AND min = INT(zhd2) AND sec = 2 THEN col8 = 1: GOSUB prscr
97.         IF monh = 6 OR monh = 12 AND day = 22 THEN nzet = -nzet
98.         a\$ = INKEY\$
99.         IF a\$ = "q" THEN END
100.         IF a\$ = "s" THEN RUN
101.         IF LEN(a\$) = 2 THEN a1\$ = RIGHT\$(a\$, 1): a1 = ASC(a1\$) ELSE GOTO ekey
102.         IF a1 = 72 OR a1 = 80 THEN dy = kys(a1 - 70)
103.         IF a1 = 75 OR a1 = 77 THEN dx = kys(a1 - 70)
104. ekey:   IF a\$ = "" THEN GOTO ink
105.            xx1 = x + dx1: yy1 = y + dy1
106.            xx = x + dx: yy = y + dy
107.         s1\$ = s9\$: s9\$ = CHR\$(SCREEN(yy, xx))
108.         IF dx <> 0 OR dy <> 0 THEN s8\$ = CHR\$(SCREEN(yy, xx))
109.         IF s9\$ >= "0" AND s9\$ <= "9" THEN GOSUB opros: GOTO g00
110.         IF a\$ = "w" THEN sw = -sw
111.         IF sw = -1 THEN LOCATE 1, 1: PRINT "  s8:" + s8\$ + "s:" + s\$ + " s9:" + s9\$ + " ss:" + ss\$ + " s1:" + s1\$ + " a:" + a\$ + "  "
112.         IF s9\$ = "+" OR s9\$ = "#" OR s9\$ >= "@" AND s9\$ <= "Z" OR s9\$ >= "a" AND s9\$ <= "z" OR s9\$ > "Ї" THEN dx = 0: dy = 0: IF ld = 0 THEN ld = 1: PLAY "n0l64": hp = hp - .01: 'CALL sy("rg s n", so\$, pr(1)): LOCATE 1, 1: PRINT name\$ + ": " + so\$: GOSUB status
113.         IF s9\$ = " " THEN dx = 0: dy = 0: ON locnn GOSUB endho
114. g00:    IF s8\$ = "<" AND a\$ = "<" THEN ador = 1: ON locnn GOSUB hofl: ador = 0
115.         IF s8\$ = ">" AND a\$ = ">" THEN ador = -1: ON locnn GOSUB hofl: ador = 0
116.         IF s8\$ = "+" AND a\$ = "o" THEN ON locnn GOSUB hodoor
117.         IF dx <> 0 OR dy <> 0 THEN ld = 0
118.         IF xx < nx1 OR xx > nx2 THEN lll = 1: GOSUB prscr: lll = 0: dx = 0
119.         IF yy < ny1 OR yy > ny2 THEN lll = 2: GOSUB prscr: lll = 0: dy = 0
120.         LOCATE y, x: COLOR soon(col8): PRINT s\$
121.         x = x + dx: y = y + dy
122.         IF dx <> 0 OR dy <> 0 THEN : ss\$ = s\$
123.         s\$ = CHR\$(SCREEN(y, x))
124.         LOCATE y, x: COLOR 15: PRINT n\$
125.         dx1 = dx: dx = 0: dy1 = dy: dy = 0
126. ink2:   GOTO ink
127. wrwall: IF wall = 5 THEN nn\$ = "±": nnr = 0: GOTO begwr
128.         IF wall = 4 THEN nn\$ = "°": nnr = .08: GOTO begwr
129.         IF wall = 3 THEN nn\$ = "І": nnr = .18: GOTO begwr
130.         IF wall = 2 THEN nn\$ = "І": nnr = .35: GOTO begwr
131.         IF wall = 1 THEN nn\$ = "^": nnr = .56: GOTO begwr
132. begwr:  FOR i = 1 TO locy
133.         lx = INT(RND * 1.99) + 2: nn1\$ = nn\$
134.         IF RND < nnr THEN IF RND < nnr THEN nn1\$ = "^":  ELSE nn1\$ = "."
135.         CALL sets(LOC\$(i), nn1\$, lx, locx)
136.         lx1 = INT(RND * 1.99) + 2: nn2\$ = nn\$
137.         IF RND < nnr THEN IF RND < nnr THEN nn2\$ = "^":  ELSE nn2\$ = "."
138.         CALL sets(LOC\$(i), nn2\$, locx - lx1, locx)
139.         NEXT i
140.         FOR i = 1 TO locx
141.         nny1 = 1: nn1\$ = nn\$
142.         IF RND > .5 THEN nny1 = 2
143.         IF RND < nnr THEN IF RND < nnr THEN nn1\$ = "^":  ELSE nn1\$ = "."
144.         CALL sets(LOC\$(nny1), nn1\$, i, locx)
145.         nny2 = locy
146.         IF RND > .5 THEN nny2 = locy - 1:
147.         nn2\$ = nn\$
148.         IF RND < nnr THEN IF RND < nnr THEN nn2\$ = "^":  ELSE nn2\$ = "."
149.         CALL sets(LOC\$(nny2), nn2\$, i, locx)
150.         NEXT i
151.
152.
153.         CALL wrl(6, 3, 4, 5, 0, LOC\$(), locx, locy)
154.
155. endwr:  ' „ Ћ ђ Ћ ѓ €
156.        CH\$ = CHR\$(249): CH\$ = CH\$ + CH\$ + CH\$ + CH\$ + CH\$ + CH\$
157.        'ch\$ = "ъъъъъъ"
158.        'CALL road(loc\$(), locx, locy, CH\$, .35)
159.
160.
161.         IF hra = 0 THEN GOTO en
162.         LET magx = 10 + INT((RND * 2.99) / 2) * 2
163.         LET magy = 6
164.         sym\$ = "О": 's12\$ = CHR\$(ASC("A"))
165.         CALL cube(LOC\$(), magx, magy, locx, locy, "І", sym\$, "І")
166.         hs\$(1, 1) = "n" + sym\$ + s12\$
167.
168. en:    ' ‹ ћ „ €
169.         FOR j = 1 TO npip
170.         CALL piples(pp\$(i, 1))
171.
172.         NEXT j
173.
174.         ' Њ Ђ ѓЂ ‡ € Ќ ›
175.         FOR j = 1 TO mag
176.         LET magx = INT(((RND * 5) + 4) / 2) * 2
177.         LET magy = 2: s12\$ = CHR\$(ASC("A") + j - 1)
178.         sym\$ = "1"
179.         CALL cube(LOC\$(), magx, magy, locx, locy, "±", sym\$, s12\$)
180.         mg\$(j, 1) = "n" + sym\$ + s12\$
181.         NEXT j
182.  '      ’ Ђ ‚ … ђ Ќ ›
183.         FOR j = 1 TO taw
184.         LET magx = 6: s12\$ = CHR\$(ASC("A") + j - 1)
185.         LET magy = 2
186.         sym\$ = "5"
187.         CALL cube(LOC\$(), magx, magy, locx, locy, "Ы", sym\$, s12\$)
188.         tw\$(j, 1) = "n" + sym\$ + s12\$
189.         NEXT j
190. '      Ћ ’ … ‹ €
191.         FOR j = 1 TO hot
192.         LET magx = 8: s12\$ = CHR\$(ASC("A") + j - 1)
193.         LET magy = 4
194.         sym\$ = "2"
195.         CALL cube(LOC\$(), magx, magy, locx, locy, "°", sym\$, s12\$)
196.         ht\$(j, 1) = "n" + sym\$ + s12\$
197.         NEXT j
198. '       „ Ћ Њ Ђ
199.         FOR j = 1 TO hos
200.         LET magx = 4
201.         LET magy = 2
202.         sym\$ = "0": s12\$ = CHR\$(ASC("!") + j - 1)
203.         CALL cube(LOC\$(), magx, magy, locx, locy, "°", sym\$, s12\$)
204.         hs\$(j, 1) = s12\$
205.         CALL hous(hs\$(j, 2), INT(RND * 3) + 2, INT(RND * .35) + .65)
206.         NEXT j
207. xnn1:     CALL tree(LOC\$(), locx, locy, CHR\$(6), .25)
208.            CALL tree(LOC\$(), locx, locy, CHR\$(5), .2)
209.            CALL tree(LOC\$(), locx, locy, CHR\$(24), .2)
210.            CALL tree(LOC\$(), locx, locy, ",", .45)
211.         col9 = 15
212.         GOSUB prscr
213.         RETURN
214.
215. prscr:  IF locnn <> 0 THEN ON locnn GOSUB opros11: RETURN
216.         CLS
217.         GOSUB status
218.
219.        IF no = 0 THEN CALL prs(LOC\$(), locx, locy, xx, yy, nx1, nx2, ny1, ny2, posx, posy, x, y, lll, soon(col8))
220.        RETURN
221. endg:
222.         RUN
223. opros:  ON VAL(s9\$) + 1 GOSUB opros1
224.         RETURN
225. opros1: PRINT xx, yy, dx, dy
226.         nh\$ = CHR\$(SCREEN(yy + dy, xx + dx + dx))
227.         PRINT "  "; nh\$
228.         FOR i = 1 TO hos
229.         IF hs\$(i, 1) = nh\$ THEN ri = i: GOTO opros11
230.         NEXT i
231. opros11: CLS : GOSUB status
232.          COLOR soon(col8)
233.          CALL wrh(hs\$(ri, 2), "", lx, door, fin)
234.          locnn = 1
235.          ox = x - dx: oy = yy - dy
236.          s09\$ = s9\$
237.          x = lx - 1: y = 8
238.          RETURN
239. endho:  IF sec < sec1 THEN CALL sp(2): RETURN
240.          x = ox: y = oy: s9\$ = s09\$: locnn = 0
241.          CLS
242.          GOSUB status
243.          CALL prs(LOC\$(), locx, locy, xx, yy, nx1, nx2, ny1, ny2, posx, posy, x, y, lll, soon(col8))
244.         RETURN
245.
246. hofl:   LOCATE 1, 1
247.         IF ador = 1 THEN CALL sex(sex1, " бЇгбвЁ«бп", " бЇгбвЁ« бм", sx\$):  ELSE CALL sex(sex1, " Ї®¤­п«бп", " Ї®¤­п« бм", sx\$)
248.         CALL sp(3)
249.         CALL wrh(hs\$(ri, 2), "f", g12, g13, fin): IF g12 < 2 AND ador = 1 THEN g12 = 2:  GOTO hhhh
250.         CALL wrh(hs\$(ri, 2), "r", g13, g14, fin): IF g12 > g13 AND ador = -1 THEN g12 = g13: GOTO hhhh
251.         CALL setwr(hs\$(ri, 2), 2, "f", g12 + (-ador), 0)
252.             flor1\$ = " ўлиҐ."
253.             IF ador = 1 THEN flor1\$ = " ­Ё¦Ґ."
254.             PRINT "   " + NAME\$ + sx\$ + " нв ¦Ґ¬ "; flor1\$
255.         COLOR soon(col8): find\$ = ""
256. hhhh:   CALL wrh(hs\$(ri, 2), find\$, lx, door, fin)
257.         s\$ = find\$: s8\$ = find\$
258.         RETURN
259.
260. hodoor: CALL sex(sex1, " pushed", " pushed", sx\$)
261.         LOCATE 1, 1: CALL sp(3)
262. door1:  PRINT "  " + NAME\$ + sx\$ + " door";
263.         IF door = 1 THEN CALL say(", and door opened.", ", and door was open.", ", and door opened."): GOTO ll4
264.         IF door = 2 THEN IF RND < .9 THEN CALL say(" door didn't open", " door didn't open", " door didn't open"): PLAY "n12l64":  ELSE CALL sp(3): door = 1: GOTO door1
265.         IF door = 3 THEN CALL say(", but door was lock.", ", but door was lock.", ", but door was lock.")
266.
267. ll4:    COLOR soon(col8)
268.         CALL wrh(hs\$(ri, 2), "d", g12, g13, fin)
269.         IF door = 1 THEN CALL setwr(hs\$(ri, 2), fin, "d", 0, 0): PLAY "n12l64"
270.         CALL wrh(hs\$(ri, 2), "", lx, door, fin)
271.
272. status: COLOR 13
273.         LOCATE 7, 3: PRINT "HP:"; INT(hp)
274.         'LOCATE 4, 3: PRINT "px:"; posx
275.         'LOCATE 5, 3: PRINT "py:"; posy
276.         'LOCATE 6, 3: PRINT "ly:"; locy
277.         LOCATE 4, 3: PRINT year; " year"
278.         LOCATE 5, 3: PRINT mon\$(mont) + ","; day; "  ";
279.         LOCATE 6, 3: PRINT hour; ":"; min; "   "
280.         COLOR soon(col8)
281.         RETURN
282.         dx = 1
283.         rn = RND:
284.         IF rn < .2 THEN dx = -1
285.         IF nx < lk AND rn < .9 THEN dy = 1:  ELSE IF ny > 1 THEN dy = -1
286.         IF nx < lk2 AND rn < .99 THEN dy = 0:  ELSE IF rn < .5 THEN dy = -1 ELSE dy = 1
287.         IF nx > lk2 AND rn < .8 AND ny > 2 THEN dy = -1:  ELSE IF nx > locx - 4 THEN dy = 1
288.         IF ny + dy < 1 THEN dy = 0
289.         IF ny > 1 AND nx = locx THEN dy = -1: dx = -1
290.         nx = nx + dx: ny = ny + dy
291.         LOCATE 4, 5: PRINT nx, ny:
292.         hx = INT(nx / 5) + 2: hy = INT(ny / 2) + 2
293.          LOCATE hy, hx: PRINT "±"
294.         FOR i = 1 TO 1100: NEXT i
295.         IF nx < 1 THEN nx = 0
296.         IF nx > locx THEN nx = locx
297.         IF ny + m(1) > locy THEN ny = locy - m(1)
298.         m1 = m(1)
299.         IF dy = -1 THEN s\$ = "/" ELSE s\$ = "\": IF dy = 0 THEN s\$ = " "
300.         's\$ = "!"
301.         IF dx = -1 THEN m1 = 1
302.         CALL sety(LOC\$(), s\$, nx, ny, m1, locx)
303.
304. SUB cph (n1, n2)
305.         IF INT(RND * 100.99) < n1 THEN n2 = 1
306.         IF INT(RND * 100.99) > n1 THEN n2 = 2
307.         END SUB
308.
309.         SUB cube (s\$(), n1, n2, n3, n4, m\$, m1\$, m2\$)
310. m1:     nnn = 0: nnn1 = 0
311.         LET n5 = INT((RND * (n3 - (n1 + 2))) / 2) * 2: IF n5 < 3 THEN GOTO m1
312.         LET n6 = INT((RND * (n4 - (n2 + 2))) / 2) * 2 + 1: IF n6 < 3 THEN GOTO m1
313.         LET wx = INT(RND * 3.99) + 1
314.        CALL scrn(s\$(n6), d\$, n5, 1)
315.         IF d\$ <> "." THEN GOTO m1
316.         CALL scrn(s\$(n6), d\$, n5 + n1 + 1, 1)
317.         IF d\$ <> "." THEN GOTO m1
318.         CALL scrn(s\$(n6 - 1), d\$, n5 + n1, 1)
319.         IF d\$ <> "." THEN GOTO m1
320.         CALL scrn(s\$(n6), d\$, n5 - 1, 1)
321.         IF d\$ <> "." THEN GOTO m1
322.         CALL scrn(s\$(n6 - 1), d\$, n5, 1)
323.         IF d\$ <> "." THEN GOTO m1
324.         CALL scrn(s\$(n6 + n2 + 1), d\$, n5, 1)
325.         IF d\$ <> "." THEN GOTO m1
326.         CALL scrn(s\$(n6 + n2), d\$, n5 - 1, 1)
327.         IF d\$ <> "." THEN GOTO m1
328.         CALL scrn(s\$(n6 + n2), d\$, n5 + n1 + 1, 1)
329.         IF d\$ <> "." THEN GOTO m1
330.         CALL scrn(s\$(n6 + n2 - 1), d\$, n5 + n1, 1)
331.         IF d\$ <> "." THEN GOTO m1
332.         CALL scrn(s\$(n6 + 1), d\$, n5 + 1, 1)
333.         IF d\$ <> "." THEN GOTO m1
334.         CALL scrn(s\$(n6 + n2 + 1), d\$, n5 + n1 + 1, 1)
335.         IF d\$ <> "." THEN GOTO m1
336.        ' CALL scrn(s\$(n6 + n2 + 1), d\$, n5, 1)
337.       '  IF d\$ <> "." THEN GOTO m1
338.
339.         FOR i = 1 TO n1
340.         s1\$ = s1\$ + m\$: ON wx GOTO m2, m3, m4, m5
341. m0:     NEXT i: s1\$ = s1\$ + m\$: IF nnn1 <> 1 THEN s5\$ = s5\$ + m\$
342.         FOR i = n6 TO n6 + n2
343.         s2\$ = LEFT\$(s\$(i), n5): s3\$ = RIGHT\$(s\$(i), n3 - n5 - n1)
344.          IF wx = 1 AND i = n6 THEN s\$(i) = s2\$ + s5\$ + s3\$: GOTO m10
345.          IF wx = 2 AND i = n6 + n2 THEN s\$(i) = s2\$ + s5\$ + s3\$: GOTO m10
346.          IF wx = 3 AND i = n6 + INT(n2 / 2) THEN s\$(i) = s2\$ + s5\$ + s3\$: GOTO m10
347.          IF wx = 4 AND i = n6 + INT(n2 / 2) THEN s\$(i) = s2\$ + s5\$ + s3\$: GOTO m10
348.         s\$(i) = s2\$ + s1\$ + s3\$
349.
350. m10:    NEXT i
351.         GOTO m7
352. m2:     IF i = INT(n1 / 2) + 1 AND nnn = 0 THEN s5\$ = s5\$ + m1\$: nnn = 1: GOTO m0
353.         s5\$ = s5\$ + m\$: GOTO m0
354. m3:     IF i = INT(n1 / 2) + 1 AND nnn = 0 THEN s5\$ = s5\$ + m1\$: nnn = 1: GOTO m0
355.         s5\$ = s5\$ + m\$: GOTO m0
356. m4:     IF i = n1 AND nnn = 0 THEN s5\$ = s5\$ + m\$ + m1\$: nnn = 1: nnn1 = 1: GOTO m0
357.         s5\$ = s5\$ + m\$: GOTO m0
358. m5:     IF i = 1 AND nnn = 0 THEN s5\$ = s5\$ + m1\$: nnn = 1: GOTO m0
359.         s5\$ = s5\$ + m\$: GOTO m0
360.
361.
362. m7:     'CALL sets(s\$(INT(n6 + (n2 / 2))), m2\$, n5 + INT(n1 / 2), n3)
363.         CALL sets(s\$(n6 + INT(n2 / 2)), m2\$, n5 + (n1 / 2), n3)
364.         END SUB
365.
366. SUB hous (h\$, f, r)
367.         CALL wr(h\$, "r", f, 0)
368.         CALL wr(h\$, "f", 2, 0)
369.         x = INT(((RND * 20) + 10) * r)
370.         y = INT(((RND * 8) + 8) * r)
371.
372.         lx = INT(RND * (x - 6)) + 3
373.         ly = INT(RND * (y - 4)) + 2
374.         CALL wr(h\$, "l", lx, ly)
375.         door = INT(RND * 2.99): IF RND < .2 THEN door = 3
376.         CALL wr(h\$, "d", door, 0)
377.         sym = INT(RND * 6.99) + 1
378.         CALL wr(h\$, "s", sym, 0)
379.         FOR i = 1 TO f
380.         CALL wr(h\$, "o", x, y)
381.         NEXT i
382. END SUB
383.
384. SUB opr (n, c\$, n1, n2)
385.         ON n GOTO mopr1, mopr2
386. mopr1:  IF c\$ = "h" THEN cx = n1
387. mopr2:
388. END SUB
389.
390. SUB piples (h\$)
391.         IF RND < .5 THEN n = 1:  ELSE n = 2
392.         CALL wr(h\$, "p", n, 0)
393.
394. END SUB
395.
396. SUB prs (LOC\$(), locx, locy, xx, yy, nx1, nx2, ny1, ny2, posx, posy, x, y, lll, col9)
397. mpr:    IF lll = 0 THEN GOTO prs0
398.         ON lll GOSUB prs1, prs2
399. prs0:   COLOR col9
400.         FOR i = 3 TO 21
401.         LOCATE i + 1, 16
402.         PRINT MID\$(LOC\$((i - 3) + posy), posx, 64)
403.         NEXT i
404. j1:     GOTO mret
405. prs1:   IF xx < nx1 THEN posx = posx - 16: x = x + 16: IF posx < 1 THEN nll = -(1 - posx): posx = 1: x = x + nll: RETURN:  ELSE RETURN
406.         IF xx > nx2 THEN posx = posx + 16: x = x - 16: IF posx > locx - 64 THEN nll = posx - (locx - 64): posx = locx - 64: x = x + nll: RETURN:  ELSE RETURN
407. prs2:   IF yy > ny2 THEN posy = posy + 6: y = y - 6: IF posy > locy - 18 THEN nll = posy - (locy - 18): posy = locy - 18: y = y + nll: RETURN:  ELSE RETURN
408.         IF yy < ny1 THEN posy = posy - 6: y = y + 6: IF posy < 1 THEN nll = -(1 - posy): posy = 1: y = y + nll: RETURN:  ELSE RETURN
409. '
410. mret:   END SUB
411.
412. SUB road (LOC\$(), locx, locy, ddd\$, nn)
413.      '   ON INT(RND * 1.99) + 1 GOTO mr1, mr2
414.          dx = 1: x = INT(locx / 2): y = 1
415. mr1:    b = LEN(ddd\$)
416.         IF RND < nn THEN dx = -dx
417.          CALL sets(LOC\$(y), ddd\$, x, locx)
418.          IF x > locx - b OR x < 1 THEN GOTO mrstop
419.          IF y > INT(locy / 2) THEN GOTO mrplace
420.         x = x + dx: y = y + 1
421.         GOTO mr1
422. mrplace: ND = INT(b * 1.5)
423.         FOR i = 1 TO ND
424.         CALL sets(LOC\$(y + i - 1), ddd\$ + ddd\$ + ddd\$, x - b, locx)
425.         NEXT i
426. '        FOR i = 1 TO 3
427. '        lx2 = INT(locx * .1)
428. '        ON i GOTO mrr1, mrr2, mrr3
429. 'mrr1:   dx = -1: y = y + INT((nd - 1) / 2): x = x - b: x1 = x: y1 = y: xy = locx - ((locx - x) + lx2): GOTO mrre
430. 'mrr2:   dx = 1: y = y1: x = x1 + b * 3: xy = INT((locx - (locx * .2)) / 2) - (b * 3) + 1: GOTO mrre
431. 'mrr3:   dy = 1: dx = 0: x = x1 + INT(b / 2): y = y1: xy = INT((locy - (locy * .2)) / 2): GOTO mrre
432. 'mrre:   FOR j = 1 TO xy - 1
433. '         dd\$ = LEFT\$(ddd\$, 4)
434. '         CLS
435. '         PRINT "j:"; j; " x:"; x; " lx:"; locx; " y:"; y; " ly:"; locy, xy
436. '         CALL sets(loc\$(y), dd\$, x, locx)
437. '        IF dx <> 0 THEN CALL sets(loc\$(y + 1), dd\$, x, locx)
438. '         x = x + dx: y = y + dy
439. '         NEXT j: NEXT i
440. mrstop: END SUB
441.
442. SUB say (n\$, n2\$, n3\$)
443.         ON INT(RND * 2.99) + 1 GOSUB msay1, msay2, msay3
444.         GOTO msaye
445. msay1:  PRINT n\$: RETURN
446. msay2:  PRINT n1\$: RETURN
447. msay3:  PRINT n2\$
448. msaye:  END SUB
449.
450. SUB scrn (s\$, s1\$, n2, ff)
451.  s1\$ = MID\$(s\$, n2, ff)
452. END SUB
453.
454. SUB sets (s\$, s1\$, n2, mx)
455. ln = LEN(s1\$)
456. s3\$ = LEFT\$(s\$, n2): s4\$ = RIGHT\$(s\$, mx - (n2 - 1 + ln))
457. s\$ = s3\$ + s1\$ + s4\$
458. END SUB
459.
460. SUB setwr (h\$, n, d\$, n1, n2)
461.         lh = LEN(h\$)
462.         x = ((n - 1) * 7)
463.         CALL wr(r\$, d\$, n1, n2)
464.         CALL sets(h\$, r\$, x, lh - 1)
465.
466. END SUB
467.
468. SUB sety (s\$(), s1\$, x, y, n, mx)
469.       ln = LEN(s1\$)
470.        FOR i = y TO y + n
471.
472.         s3\$ = LEFT\$(s\$(i), x): s4\$ = RIGHT\$(s\$(i), mx - (x - 1 + ln))
473.         s\$(i) = s3\$ + s1\$ + s4\$
474.        NEXT i
475. END SUB
476.
477. SUB sex (sex1, h1\$, h2\$, sx\$)
478.         ON sex1 GOTO msex1, msex2
479.         GOTO msexe
480. msex1:  sx\$ = h1\$: GOTO msexe
481. msex2:  sx\$ = h2\$
482. msexe:  END SUB
483.
484. SUB sp (n)
485. LOCATE 1, 1
486. FOR i = 1 TO n
487. PRINT "                                                                             "
488. NEXT i: LOCATE 1, 1
489. END SUB
490.
491. SUB sy (m\$, m1\$, n)
492.         a\$ = LEFT\$(m\$, 2)
493.         IF a\$ = "rg" THEN GOTO mrug
494.         GOTO mend
495. mrug:   a\$ = MID\$(m\$, 4, 1)
496.         IF a\$ = "s" THEN c = 1: c1 = 8
497.         a\$ = MID\$(m\$, 6, 1)
498.         IF a\$ = "n" THEN GOTO mrug1
499.         GOTO mend
500. mrug1:  CALL cph(n, d)
501.        ' m2\$ = sl\$(1, INT(RND * c1 - .01) + 1)
502.         ON d GOTO mrug2, mrug3
503. mrug2:  'call spr(1,
504. mrug3:
505. mend:   END SUB
506.
507. SUB tree (LOC\$(), locx, locy, d\$, n)
508.         n1 = INT((RND * ((locx * locy) / 30)) * n)
509.         nn = INT(RND * (n1 / 2) + (n1 / 1.25))
510.         FOR i = 1 TO nn
511. mtr1:   x = INT(((RND * (locx - 5)) + 3) / 2) * 2 + 1: y = INT((RND * (locy - 5)) + 3)
512.         CALL scrn(LOC\$(y), g\$, x, 1): IF g\$ <> "." THEN GOTO mtr1
513.         CALL sets(LOC\$(y), d\$, x, locx)
514. mtrn:   NEXT i
515. END SUB
516.
517. SUB wr (h\$, d\$, x, y)
518.  x\$ = STR\$(x): IF LEN(x\$) > 2 THEN x\$ = RIGHT\$(x\$, 2)
519.  y\$ = STR\$(y): IF LEN(y\$) > 2 THEN y\$ = RIGHT\$(y\$, 2)
520. h\$ = h\$ + d\$ + x\$ + "," + y\$ + ";"
521. END SUB
522.
523. SUB wrh (h\$, find\$, lx, door, fin)
524.         h = LEN(h\$)
525.         FOR i = 1 TO h
526.         a\$ = MID\$(h\$, i, 1)
527.         IF find\$ <> "" THEN IF a\$ = find\$ THEN fin = INT(i / 7) + 1: ffin\$ = find\$: find\$ = "" ELSE GOTO mnx
528.         IF n = 0 THEN c\$ = a\$: n1\$ = "": n2\$ = "": n = 1: GOTO mnx
529.         IF a\$ = "," THEN n = 2: GOTO mnx
530.         IF n = 1 THEN n1\$ = n1\$ + a\$
531.         IF a\$ = ";" THEN n = 0: GOSUB mcall: GOTO mnx
532.         IF n = 2 THEN n2\$ = n2\$ + a\$
533. mnx:    NEXT i: GOTO mwrhe
534. mcall:  n1 = VAL(n1\$): n2 = VAL(n2\$)
535.         IF c\$ = ffin\$ THEN lx = n1: door = n2: GOTO mwrhe
536.         IF c\$ = "r" THEN nr = n1: RETURN
537.         IF c\$ = "f" THEN nfl = n1: RETURN
538.         IF c\$ = "l" THEN lxx = n1: lyy = n2: RETURN
539.         IF c\$ = "d" THEN door = n1: RETURN
540.        IF c\$ = "s" THEN sym = n1: RETURN
541.         IF c\$ = "o" THEN nfl1 = nfl1 + 1: IF nfl1 = nfl THEN xf = n1: yf = n2: GOSUB mflor: RETURN
542.         RETURN
543. mflor:  hh1\$ = "°±І#Ы=і": hh\$ = MID\$(hh1\$, sym, 1)
544.         yy = 4
545.         xx = 52 - INT(xf / 2)
546.         FOR j = 1 TO xf
547.         IF sym < 7 THEN d\$ = d\$ + hh\$
548.         IF sym = 7 THEN IF j = 1 THEN d\$ = d\$ + "Ъ": d2\$ = d2\$ + "А":  ELSE IF j = xf THEN d\$ = d\$ + "ї": d2\$ = d2\$ + "Щ":  ELSE d\$ = d\$ + "Д": d2\$ = d2\$ + "Д"
549.         IF j = 1 OR j = xf THEN d1\$ = d1\$ + hh\$: d5\$ = d5\$ + "I":  ELSE d1\$ = d1\$ + ".": d5\$ = d5\$ + "."
550.
551.         NEXT j: d\$ = d\$ + "....": d1\$ = d1\$ + "....": d2\$ = d2\$ + "....": d5\$ = d5\$ + "...."
552.         LOCATE yy + 1, xx
553.         PRINT d\$
554.         FOR j = 1 TO yf - 1
555.         LOCATE yy + j + 1, xx
556.         IF sym <> 6 THEN PRINT d1\$ ELSE PRINT d5\$
557.         NEXT j
558.         LOCATE yy + yf + 1, xx
559.         IF sym <> 7 THEN PRINT d\$:  ELSE PRINT d2\$
560.         PRINT : PRINT SPC(xx);
561.         IF nfl > 1 THEN PRINT "ќв ¦:"; nfl - 1; "  " ELSE PRINT "Џ®¤ў «."
562.         LOCATE yy + INT(yf / 2 + .5), xx + xf - 1
563.         IF nfl = 2 AND door = 0 THEN sss\$ = "\"
564.         IF nfl = 2 AND door <> 0 THEN sss\$ = "+"
565.         IF nfl <> 2 THEN sss\$ = ""
566.         PRINT sss\$
567.         lx = xx + xf + 3
568.         LOCATE yy + lyy, xx + lxx
569.         IF nfl = 2 AND nr = 2 THEN PRINT "<": RETURN
570.         IF nfl = nr THEN find\$ = "<": RETURN
571.         IF nfl = 1 THEN find\$ = ">": RETURN
572.         PRINT "<>"
573.          RETURN
574. mwrhe:   END SUB
575.
576. SUB wrl (u, d, l, r, c, LOC\$(), locx, locy)
577.         DIM m(5), mm(5), dd(5)
578.         m(1) = u: m(2) = d: m(3) = l: m(4) = r: m(5) = c
579.         FOR i = 1 TO 5: d = 0
580.         FOR j = 1 TO 5
581.         IF m(i) <= m(j) THEN d = d + 1
582.         NEXT j: mm(i) = d: dd(d) = i
583.         NEXT i
584.         'FOR i = 1 TO 5
585.         vid = 1: ' m (dd(1))
586.         ON vid GOTO mup', mdw, mlf, mrg, cen
587. mup:
588.          lk = INT(locx / (RND * 4 + 1)): lk2 = INT(locx / 1.5)
589.
590.          z = 5
591.          IF m(5) = m(1) THEN z = 2
592.          maxy = INT(RND * 20 + (locy / z))
593.          sty = maxy / lk
594.          y = 1
595.          FOR x = 1 TO locx
596.
597.          CALL sety(LOC\$(), "і", x, INT(y), m(1), locx)
598.          IF x < lk THEN y = y + sty
599.          IF x >= lk2 THEN y = y - sty
600.          IF INT(y) < 1 THEN y = 1
601.          NEXT x
602. END SUB
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top