WHILE AND DO LOOP CYCLES

[Kiara87]

HELLO EVERYONE

I wanted to know which cycle is better among them
while or do while
do loop
or other cycles can be infinite
which are the most modern cycles among them

DO
~~~
LOOP WHILE n > 0

DO WHILE n > 0
~~~
LOOP

DO UNTIL n = 0
~~~
LOOP

WHILE
~~~
WEND

DO
~~~
LOOP

DO
~~~
LOOP UNTIL n > 0

in other programming languages

there is only
WHILE
DO WHILE
INSTEAD QB64 HAS MORE THAN TWO ?

[_vince]

WHILE...WEND is equivalent to DO WHILE, it is the old gwbasic notation.  I personally stick to DO WHILE as it is more consistent with all the other variants.

Since all the variants are effectively different, I'd use the one that best fits the situation leaning towards DO WHILE whenever possible.  I would also avoid EXIT DO and _CONTINUE inside loops whenever possible as it is essentially spaghetti code.  Having a single exit condition on the top DO WHILE line is going to look the neatest and most readable.

[bplus]

Your basic DO LOOP is fine, I use WHILE...WEND if there is a condition to test before entering a loop and DO... LOOP UNTIL if you need to run the loop at least once. DO WHILE is an extra word to type!

_EXIT and _CONTINUE are great! The execution picks up at end or start of loop, no spaghetti when the blocks are indented it is easy as eating pie knowing where execution will pick up.

Spaghetti is arbitrary GOTO this and that with no returns so it's jumping all over the source code and execution is extremely hard to follow.

PS The FOR... NEXT loop takes a tiny bit longer but is a natural for array work, do you think you will miss .000002 secs?

[Richard Frost]

Thousands of clowns throughout history have proven that the best cycle is a
unicycle.  The variety available with QB64 is wonderful.  I bet all these variations
compile to the same super-dooper skinny ones and fat zeros.

The FOR/NEXT loop is slower.  This I have tested.  Hence eliminating it from time
critical sections of my chess program. 

Code: QB64: [Select]

1. stars = 100
2. two_four = 24 + 2
3. kfc_franchise = 20 + 1
4. nine_lives = 9 + 2
5.  
6. PRINT: PRINT: PRINT "stars";
7. DO: _LIMIT 300
8.     stars = stars - 1
9.     PRINT stars;
10. LOOP UNTIL (stars = 0) OR End_Of_Universe
11.  
12. PRINT: PRINT: PRINT "beer";
13. DO: _LIMIT 300
14.     two_four = two_four - 1
15.     PRINT two_four;
16. LOOP WHILE two_four > 0
17.  
18. PRINT: PRINT: PRINT "chickens";
19. DO WHILE kfc_franchise > 0
20.     _LIMIT 300
21.     kfc_franchise = kfc_franchise - 1
22.     PRINT kfc_franchise;
23. LOOP
24.  
25. PRINT: PRINT: PRINT "cat";
26. WHILE NOT (Dead)
27.     _LIMIT 300
28.     cat_status = (cat_status + 1) MOD nine_lives
29.     IF cat_status = 0 THEN Dead = -1 ELSE PRINT nine_lives - cat_status - 1;
30. WEND
31.  
32. PRINT: PRINT: PRINT "Buddy Holly";
33. DO WHILE dowoppa = dowap
34.     _LIMIT 100
35.     IF RND > .9 THEN
36.         dowap = 1
37.         PRINT " dowap";
38.     ELSE
39.         PRINT " wappa";
40.     END IF
41. LOOP

[Kiara87]

thank you both
for replying

@bplus I thought  that you could create spaghetti code with GOSUB,_CONTINUE and not only with goto

thanks for useful information


thanks also to _vince
I did not know that while wend equal do while

[bplus]

GOSUB not nearly as bad as arbitrary GOTO, and GOTO is not evil nor bad and can be quite appropriate occasionally.

_CONTINUE wasn't even invented back in the day when they started complaining about spaghetti code.

[_vince]

_EXIT and _CONTINUE are great! The execution picks up at end or start of loop, no spaghetti when the blocks are indented it is easy as eating pie knowing where execution will pick up.

Spaghetti is arbitrary GOTO this and that with no returns so it's jumping all over the source code and execution is extremely hard to follow.

I'd say that spaghetti code isn't exclusive to the use of GOTO, it's more the concept of having difficult to follow code because of complicated and disorganized jumping/branching.

Some guys will have just a plain Do...LOOP and bury the exit conditions somewhere deep in that block -- I would most often categorize that as spaghetti code.  When you see a DO WHILE x<10 as the first line, you instantly know the condition of exiting that loop and don't have to dig deep in the block to find out how and when, especially if the loop is very large and complicated.

Of course, there are always exceptions when such a thing might be absolutely necessary, maybe due to the algorithm, performance constraints, etc. as is with GOTO, but I personally stick to these principles unless there's a very good reason not to

[SMcNeill]

Generally speaking, I consider code that flows backwards, or code that jumps to jump, to be “spaghetti code”.

For example:


label:
DO
   IF whatever GOTO label
LOOP

If you follow the flow here, it goes from top-down (which is what we want to see and deal with), until all at once it wraps back around to a previous point.  If you’re looking at stretching out a rope (or spaghetti) like this, you just kinked a knot in it.  Unless absolutely required, these type of structures need to be avoided.

DO
   IF whatever GOTO label1
LOOP

label1: GOTO label2

If you dig up old QBASIC code, you’ll see junk like the above in different programs.  A jump to a jump, which might just be a jump to another jump.

This is just blaaaarrgghhhhhffttt!!


As far as I’m concerned, as long as you have a simple one-directional, top-down flow, it’s hard to call it “spaghetti code”.

DO
    IF whatever GOTO label
LOOP

label:

Personally, I have no issues with the above.  It’s still a simple top-down logic, and if your labels are well-named, it becomes self-documenting, such as below:

DO
   IF whatever GOTO EndOfPrinting
LOOP

EndOfPrinting:


But, then again, this is just my personal take on the concept.  Like usual, if you’re working for someone else, you code to their standards, and not mine.  If the boss don’t like it, don’t do it just “cause Steve would”.  :P

[Kiara87]

Generally speaking, I consider code that flows backwards, or code that jumps to jump, to be “spaghetti code”.

For example:


label:
DO
   IF whatever GOTO label
LOOP

If you follow the flow here, it goes from top-down (which is what we want to see and deal with), until all at once it wraps back around to a previous point.  If you’re looking at stretching out a rope (or spaghetti) like this, you just kinked a knot in it.  Unless absolutely required, these type of structures need to be avoided.

DO
   IF whatever GOTO label1
LOOP

label1: GOTO label2

If you dig up old QBASIC code, you’ll see junk like the above in different programs.  A jump to a jump, which might just be a jump to another jump.

This is just blaaaarrgghhhhhffttt!!


As far as I’m concerned, as long as you have a simple one-directional, top-down flow, it’s hard to call it “spaghetti code”.

DO
    IF whatever GOTO label
LOOP

label:

Personally, I have no issues with the above.  It’s still a simple top-down logic, and if your labels are well-named, it becomes self-documenting, such as below:

DO
   IF whatever GOTO EndOfPrinting
LOOP

EndOfPrinting:


But, then again, this is just my personal take on the concept.  Like usual, if you’re working for someone else, you code to their standards, and not mine.  If the boss don’t like it, don’t do it just “cause Steve would”.  :P

and true I have many qbasic books and I would say they use goto a lot

from what I understand what you said if the goto goes from the other down it would not be spaghetti code?

but if the goto returns the code above, could we say it is a spaghetti code?

I don't know if I understood correctly?

then i did a google search how to avoid spaghetti code

the answer is by creating programs with structured programming
avoiding the goto using --> Sequence,selection,iteration
second hypothesis  Böhm-Jacopini

 thanx SMcNeill

[Dimster]

Like Kiara87  I do find the term "spaghetti code" somewhat confusing. I will often have loops which watch for a condition and then jump out, do something else and then go back to the loop and continue on. I will use Labels (and on the odd occasion GOTO) to handle Errors and once dealt with go back to where ever the program had encountered the error and carry on. I suppose this is spaghetti coding???

[TempodiBasic]

Hi
from my point of view
this is an old style of coding a program

Code: QB64: [Select]

1. 10 PRINT TAB(32);"ANIMAL"
2. 20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
3. 30 PRINT: PRINT: PRINT
4. 40 PRINT "PLAY 'GUESS THE ANIMAL'"
5. 45 PRINT
6. 50 PRINT "THINK OF AN ANIMAL AND THE COMPUTER WILL TRY TO GUESS IT."
7. 60 PRINT
8. 70 DIM A$(200)
9. 80 FOR I=0 TO 3
10. 90 READ A$(I)
11. 100 NEXT I
12. 110 N=VAL(A$(0))
13. 120 REM          MAIN CONTROL SECTION
14. 130 INPUT "ARE YOU THINKING OF AN ANIMAL";A$
15. 140 IF A$="LIST" THEN 600
16. 150 IF LEFT$(A$,1)<>"Y" THEN 120
17. 160 K=1
18. 170 GOSUB 390
19. 180 IF LEN(A$(K))=0 THEN 999
20. 190 IF LEFT$(A$(K),2)="\Q" THEN 170
21. 200 PRINT "IS IT A ";RIGHT$(A$(K),LEN(A$(K))-2);
22. 210 INPUT A$
23. 220 A$=LEFT$(A$,1)
24. 230 IF LEFT$(A$,1)="Y" THEN PRINT "WHY NOT TRY ANOTHER ANIMAL?": GOTO 120
25. 240 INPUT "THE ANIMAL YOU WERE THINKING OF WAS A ";V$
26. 250 PRINT "PLEASE TYPE IN A QUESTION THAT WOULD DISTINGUISH A"
27. 260 PRINT V$;" FROM A ";RIGHT$(A$(K),LEN(A$(K))-2)
28. 270 INPUT X$
29. 280 PRINT "FOR A ";V$;" THE ANSWER WOULD BE ";
30. 290 INPUT A$
31. 300 A$=LEFT$(A$,1): IF A$<>"Y" AND A$<>"N" THEN 280
32. 310 IF A$="Y" THEN B$="N"
33. 320 IF A$="N" THEN B$="Y"
34. 330 Z1=VAL(A$(0))
35. 340 A$(0)=STR$(Z1+2)
36. 350 A$(Z1)=A$(K)
37. 360 A$(Z1+1)="\A"+V$
38. 370 A$(K)="\Q"+X$+"\"+A$+STR$(Z1+1)+"\"+B$+STR$(Z1)+"\"
39. 380 GOTO 120
40. 390 REM     SUBROUTINE TO PRINT QUESTIONS
41. 400 Q$=A$(K)
42. 410 FOR Z=3 TO LEN(Q$)
43. 415 IF MID$(Q$,Z,1)<>"\" THEN PRINT MID$(Q$,Z,1);
44. 417 NEXT Z
45. 420 INPUT C$
46. 430 C$=LEFT$(C$,1)
47. 440 IF C$<>"Y" AND C$<>"N" THEN 410
48. 450 T$="\"+C$
49. 455 FOR X=3 TO LEN(Q$)-1
50. 460 IF MID$(Q$,X,2)=T$ THEN 480
51. 470 NEXT X
52. 475 STOP
53. 480 FOR Y=X+1 TO LEN(Q$)
54. 490 IF MID$(Q$,Y,1)="\" THEN 510
55. 500 NEXT Y
56. 505 STOP
57. 510 K=VAL(MID$(Q$,X+2,Y-X-2))
58. 520 RETURN
59. 530 DATA "4","\QDOES IT SWIM\Y2\N3\","\AFISH","\ABIRD"
60. 600 PRINT:PRINT "ANIMALS I ALREADY KNOW ARE:"
61. 605 X=0
62. 610 FOR I=1 TO 200
63. 620 IF LEFT$(A$(I),2)<>"\A" THEN 650
64. 624 PRINT TAB(15*X);
65. 630 FOR Z=3 TO LEN(A$(I))
66. 640 IF MID$(A$(I),Z,1)<>"\" THEN PRINT MID$(A$(I),Z,1);
67. 642 NEXT Z
68. 645 X=X+1: IF X=4 THEN X=0: PRINT
69. 650 NEXT I
70. 660 PRINT
71. 670 PRINT
72. 680 GOTO 120
73. 999 END
74.  

that we can call "spaghetti code"... the program runs ok... but its readableness is very poor, now think how  you work to modify this code to guess a number at the place of an animal...the maintenance is harder than a program with code written using the structured technique

this one also using GOTO has a more readableness

Code: QB64: [Select]

1. 5 CLS
2. PRINT "1) ADD"
3. PRINT "2) MULTIPLY"
4. PRINT "3) DIVIDE"
5. PRINT "4) SQUARE ROOT"
6. PRINT "5) EXIT"
7. INPUT I
8. IF I = 1 GOTO 10
9. IF I = 2 GOTO 20
10. IF I = 3 GOTO 30
11. IF I = 4 GOTO 40
12. IF I = 5 GOTO 50
13. END
14. 10 CLS : PRINT "INPUT NUMBER"
15. INPUT A
16. CLS
17. PRINT "INPUT NEXT NUMBER"
18. INPUT B
19. CLS
20. PRINT A + B
21. PRINT "PRESS SPACE TO RUN"
22. SLEEP 0
23. GOTO 5
24. 20 CLS : PRINT "INPUT NUMBER"
25. INPUT C
26. CLS
27. PRINT "INPUT NEXT NUMBER"
28. INPUT D
29. CLS
30. PRINT C * D
31. PRINT "PRESS SPACE TO RUN"
32. SLEEP 0
33. GOTO 5
34. 30 CLS : PRINT "INPUT NUMBER"
35. INPUT E
36. CLS
37. PRINT "INPUT NEXT NUMBER"
38. INPUT F
39. CLS
40. PRINT E / F
41. PRINT "PRESS SPACE TO RUN"
42. SLEEP 0
43. GOTO 5
44. 40 CLS : PRINT "INPUT NUMBER"
45. INPUT G
46. CLS
47. PRINT SQR(G)
48. PRINT "PRESS SPACE TO RUN"
49. SLEEP 0
50. GOTO 5
51. 50 END
52.  

Today we can avoid this kind of GOTOing, here the same code structured

Code: QB64: [Select]

1. DO
2.     Info
3.     INPUT I
4.     SELECT CASE I
5.         CASE 1
6.             CLS: PRINT "INPUT NUMBER"
7.             INPUT A
8.             CLS
9.             PRINT "INPUT NEXT NUMBER"
10.             INPUT B
11.             CLS
12.             PRINT A + B
13.             PRINT "PRESS SPACE TO RUN"
14.             SLEEP 0
15.  
16.         CASE 2
17.             CLS: PRINT "INPUT NUMBER"
18.             INPUT C
19.             CLS
20.             PRINT "INPUT NEXT NUMBER"
21.             INPUT D
22.             CLS
23.             PRINT C * D
24.             PRINT "PRESS SPACE TO RUN"
25.             SLEEP 0
26.  
27.         CASE 3
28.             CLS: PRINT "INPUT NUMBER"
29.             INPUT E
30.             CLS
31.             PRINT "INPUT NEXT NUMBER"
32.             INPUT F
33.             CLS
34.             PRINT E / F
35.             PRINT "PRESS SPACE TO RUN"
36.             SLEEP 0
37.  
38.         CASE 4
39.             CLS: PRINT "INPUT NUMBER"
40.             INPUT G
41.             CLS
42.             PRINT SQR(G)
43.             PRINT "PRESS SPACE TO RUN"
44.             SLEEP 0
45.  
46.         CASE 5
47.             END
48.     END SELECT
49. LOOP
50.  
51.  
52.  
53. SUB Info
54.     CLS
55.     PRINT "1) ADD"
56.     PRINT "2) MULTIPLY"
57.     PRINT "3) DIVIDE"
58.     PRINT "4) SQUARE ROOT"
59.     PRINT "5) EXIT"
60. END SUB

Here for the coder is easier to modify the instruction if he must add a new function to the calculator for example Substraction! :-)
but using the structured technique you can reach more complex code without loose its readableness
this is an example

Code: QB64: [Select]

1. DEFINT A-Z
2. DECLARE FUNCTION ak$ ()
3. DECLARE FUNCTION chot (t)
4. DECLARE FUNCTION chou (t)
5. DECLARE FUNCTION cr (t)
6. DECLARE FUNCTION cw (t)
7. DECLARE FUNCTION di (d1, d2)
8. DECLARE FUNCTION lts$ (nu)
9. DECLARE FUNCTION ltsb$ (nu&)
10. DECLARE FUNCTION ner (dn, max)
11. DECLARE FUNCTION nerb& (dn, max&)
12. DECLARE FUNCTION nerk$ ()
13. DECLARE FUNCTION txk$ ()
14. DECLARE SUB act (rl, t)
15. DECLARE SUB ar (t)
16. DECLARE SUB auc (t)
17. DECLARE SUB b ()
18. DECLARE SUB bca (t, houf, hotf)
19. DECLARE SUB box ()
20. DECLARE SUB broke (t)
21. DECLARE SUB buhot (t)
22. DECLARE SUB buhou (t)
23. DECLARE SUB ce (dn, tx$)
24. DECLARE SUB chk (l, m, h)
25. DECLARE SUB clk (se!)
26. DECLARE SUB cont (t, nos)
27. DECLARE SUB crd ()
28. DECLARE SUB dcha (t)
29. DECLARE SUB dche (t)
30. DECLARE SUB dy (wt)
31. DECLARE SUB fd (rl1, rl2, d1, d2, d3, d4)
32. DECLARE SUB gov (t)
33. DECLARE SUB inc (t)
34. DECLARE SUB init ()
35. DECLARE SUB inv ()
36. DECLARE SUB lil (wt)
37. DECLARE SUB lop (rl, t)
38. DECLARE SUB mb ()
39. DECLARE SUB md ()
40. DECLARE SUB mini (gr)
41. DECLARE SUB mob (t)
42. DECLARE SUB more (t)
43. DECLARE SUB mort (t)
44. DECLARE SUB move (dist, t)
45. DECLARE SUB noo (t)
46. DECLARE SUB opt (t)
47. DECLARE SUB p ()
48. DECLARE SUB pay (t, cge)
49. DECLARE SUB pim (gr, l, m, h)
50. DECLARE SUB popp (t, cge)
51. DECLARE SUB quit ()
52. DECLARE SUB rlc (t)
53. DECLARE SUB rules ()
54. DECLARE SUB save (t)
55. DECLARE SUB scha ()
56. DECLARE SUB sche ()
57. DECLARE SUB short (t, l, m, h)
58. DECLARE SUB shot (t)
59. DECLARE SUB shou (t)
60. DECLARE SUB sml (wt)
61. DECLARE SUB swbd ()
62. DECLARE SUB swbs ()
63. DECLARE SUB tiny (wt)
64. DECLARE SUB tj (t)
65. DECLARE SUB tn (t)
66. DECLARE SUB trade ()
67. DECLARE SUB unm (t)
68. DECLARE SUB upd ()
69. DECLARE SUB utc (t)
70. DECLARE SUB vwd ()
71. TYPE dd
72. ttl AS STRING * 21
73. ab AS STRING * 5
74. sty AS STRING * 1
75. c AS INTEGER
76. r AS INTEGER
77. r1 AS INTEGER
78. r2 AS INTEGER
79. r3 AS INTEGER
80. r4 AS INTEGER
81. rhot AS INTEGER
82. bc AS INTEGER
83. hue AS INTEGER
84. od AS INTEGER
85. oa AS INTEGER
86. id AS INTEGER
87. ia AS INTEGER
88. bdn AS INTEGER
89. bac AS INTEGER
90. own AS INTEGER
91. stat AS INTEGER
92. mop AS INTEGER
93. hk AS INTEGER
94. END TYPE
95. TYPE pl
96. ft AS STRING * 8
97. tk AS STRING * 1
98. c AS LONG
99. whr AS INTEGER
100. jc AS INTEGER
101. dc AS INTEGER
102. chag AS INTEGER
103. cheg AS INTEGER
104. END TYPE
105. ON ERROR GOTO 1
106. RANDOMIZE TIMER
107. DIM SHARED sf!, uf!, j, bn, x, q, fr&, bhu, bht, top(1 TO 6) AS STRING * 7, mdd(1 TO 6) AS STRING * 7, bot(1 TO 6) AS STRING * 7, cha(1 TO 16), che(1 TO 16), lot(39) AS dd, st(1 TO 2) AS pl
108. CLS
109. mb
110. md
111. swbd
112. cont t, nos
113. IF nos THEN
114. rules
115. bhu = 32
116. bht = 12
117. init
118. t = 1
119. END IF
120. IF st(1).whr > -10 THEN
121. LOCATE lot(st(1).whr).od, lot(st(1).whr).oa
122. PRINT st(1).tk
123. END IF
124. IF st(2).whr > -10 THEN
125. LOCATE lot(st(2).whr).id, lot(st(2).whr).ia
126. PRINT st(2).tk
127. END IF
128. DO
129. IF st(t).whr > -10 THEN tn t ELSE tj t
130. t = 3 - t
131. LOOP
132. 1
133. SELECT CASE ERR
134. CASE 53
135. nos = -1
136. RESUME NEXT
137. CASE 255
138. ce 10, "The save is faulty."
139. ce 11, "I will delete it."
140. p
141. nos = -1
142. CLOSE
143. KILL "monopoly.dat"
144. RESUME NEXT
145. CASE ELSE
146. box
147. ce 5, "Crash " + lts(ERR) + " has happened."
148. ce 7, "Take note of what was going on just before the crash."
149. ce 9, "Contact me at grahambhg@yahoo.com,"
150. ce 10, "and I will see what I can do."
151. crd
152. END SELECT
153. DATA ,,o,,,,,,,,,,23,78,21,72,,
154. DATA Mediterranean Avenue,MEDIT,b,60,2,10,30,90,160,250,50,5,23,68,21,68,22,65
155. DATA ,,o,,,,,,,,,,23,61,21,61,,
156. DATA Baltic Avenue,BALTI,b,60,4,20,60,180,320,450,50,5,23,54,21,54,22,51
157. DATA ,,o,,,,,,,,,,23,47,21,47,,
158. DATA Reading Railroad,READR,r,200,,25,50,100,200,,,7,23,40,21,40,,
159. DATA Oriental Avenue,ORIEN,b,100,6,30,90,270,400,550,50,11,23,33,21,33,22,30
160. DATA ,,o,,,,,,,,,,23,26,21,26,,
161. DATA Vermont Avenue,VERMO,b,100,6,30,90,270,400,550,50,11,23,19,21,19,22,16
162. DATA Conneticut Avenue,CONNE,b,120,8,40,100,300,450,600,50,11,23,12,21,12,22,9
163. DATA ,,o,,,,,,,,,,23,2,21,8,,
164. DATA Saint Charles Place,STCHA,b,140,10,50,150,450,625,750,100,13,20,2,20,9,20,8
165. DATA Electric Company,ELECT,u,150,,,,,,,,7,18,2,18,9,,
166. DATA States Avenue,STATE,b,140,10,50,150,450,625,750,100,13,16,2,16,9,16,8
167. DATA Virginia Avenue,VIRGI,b,160,12,60,180,500,700,900,100,13,14,2,14,9,14,8
168. DATA Pennsylvania Railroad,PENRR,r,200,,25,50,100,200,,,7,12,2,12,9,,
169. DATA Saint James Place,STJAM,b,180,14,70,200,550,750,950,100,12,10,2,10,9,10,8
170. DATA ,,o,,,,,,,,,,8,2,8,9,,
171. DATA Tennessee Avenue,TENNE,b,180,14,70,200,550,750,950,100,12,6,2,6,9,6,8
172. DATA New York Avenue,NEWYO,b,200,16,80,220,600,800,1000,100,12,4,2,4,9,4,8
173. DATA ,,o,,,,,,,,,,1,2,3,8,,
174. DATA Kentucky Avenue,KENTU,b,220,18,90,250,700,875,1050,150,4,1,12,3,12,2,15
175. DATA ,,o,,,,,,,,,,1,19,3,19,,
176. DATA Indiana Avenue,INDIA,b,220,18,90,250,700,875,1050,150,4,1,26,3,26,2,29
177. DATA Illinois Avenue,ILLIN,b,240,20,100,300,750,925,1100,150,4,1,33,3,33,2,36
178. DATA B. & O. Railroad,B&ORR,r,200,,25,50,100,200,,,7,1,40,3,40,,
179. DATA Atlantic Avenue,ATLAN,b,260,22,110,330,800,975,1150,150,14,1,47,3,47,2,50
180. DATA Ventnor Avenue,VENTN,b,260,22,110,330,800,975,1150,150,14,1,54,3,54,2,57
181. DATA Water Works,WATER,u,150,,,,,,,,7,1,61,3,61,,
182. DATA Marvin Gardens,MARVI,b,280,24,120,360,850,1025,1200,150,14,1,68,3,68,2,71
183. DATA ,,o,,,,,,,,,,1,78,3,72,,
184. DATA Pacific Avenue,PACIF,b,300,26,130,390,900,1100,1275,200,10,4,78,4,71,4,72
185. DATA North Carolina Avenue,NORTH,b,300,26,130,390,900,1100,1275,200,10,6,78,6,71,6,72
186. DATA ,,o,,,,,,,,,,8,78,8,71,,
187. DATA Pennsylvania Avenue,PENAV,b,320,28,150,450,1000,1200,1400,200,10,10,78,10,71,10,72
188. DATA Short Line,SHORT,r,200,,25,50,100,200,,,7,12,78,12,71,,
189. DATA ,,o,,,,,,,,,,14,78,14,71,,
190. DATA Park Place,PARKP,b,350,35,175,500,1100,1300,1500,200,9,16,78,16,71,16,72
191. DATA ,,o,,,,,,,,,,18,78,18,71,,
192. DATA Boardwalk,BOARD,b,400,50,200,600,1400,1700,2000,200,9,20,78,20,71,20,72
193.  
194. SUB act (rl, t)
195. SELECT CASE st(t).whr
196. CASE 0
197. ce 10, "You landed on Go."
198. IF bn THEN
199. st(t).c = st(t).c + 200
200. ce 11, "Collect $400."
201. ELSE
202. ce 11, "Collect $200."
203. END IF
204. p
205. CASE 2, 17, 33
206. dche t
207. CASE 4
208. inc t
209. CASE 7, 22, 36
210. dcha t
211. CASE 10
212. ce 10, "Just visiting"
213. p
214. CASE 20
215. ce 10, "Free Parking"
216. IF j THEN
217. ce 11, "You get $" + ltsb(fr&)
218. st(t).c = st(t).c + fr&
219. fr& = 500
220. END IF
221. p
222. CASE 30
223. ar t
224. CASE 38
225. ce 10, "Luxury Tax. Pay $75."
226. p
227. pay t, 75
228. IF j THEN fr& = fr& + 75
229. p
230. CASE ELSE
231. lop rl, t
232. END SELECT
233. END SUB
234.  
235. FUNCTION ak$
236. DO
237. LOOP UNTIL INKEY$ = ""
238. DO
239. tx$ = LCASE$(INKEY$)
240. LOOP UNTIL tx$ > ""
241. ak = tx$
242. END FUNCTION
243.  
244. SUB ar (t)
245. ce 9, RTRIM$(st(t).ft) + " will be sent directly to Jail."
246. p
247. IF t = 1 THEN LOCATE lot(st(1).whr).od, lot(st(1).whr).oa ELSE LOCATE lot(st(2).whr).id, lot(st(2).whr).ia
248. PRINT " "
249. st(t).whr = -10
250. st(t).dc = 0
251. box
252. END SUB
253.  
254. SUB auc (t)
255. lwst = INT(.5 + lot(st(t).whr).c / 10)
256. bj = INT(.5 + lwst / 2)
257. nw = lwst
258. box
259. COLOR lot(st(t).whr).hue
260. ce 5, RTRIM$(lot(st(t).whr).ttl)
261. COLOR 15
262. ce 6, RTRIM$(st(1).ft) + ", you have $" + ltsb(st(1).c)
263. ce 7, "Do I hear $" + lts(nw) + "?"
264. IF cr(1) + st(1).c >= nw THEN ce 8, "(Y/N)" ELSE ce 8, "press N to Not bid."
265. DO
266. LOOP UNTIL INKEY$ = ""
267. DO
268. yn$ = LCASE$(INKEY$)
269. LOOP UNTIL yn$ = "n" OR (yn$ = "y" AND cr(1) + st(1).c >= nw)
270. IF yn$ = "y" THEN
271. ce 10, " I hear $" + lts(nw)
272. nw = nw + bj
273. bidder = 1
274. ELSE
275. ce 10, RTRIM$(st(1).ft) + " passes first bid."
276. END IF
277. clk .5
278. box
279. COLOR lot(st(t).whr).hue
280. ce 5, RTRIM$(lot(st(t).whr).ttl)
281. COLOR 15
282. ce 6, RTRIM$(st(2).ft) + ", you have $" + ltsb(st(2).c)
283. ce 7, "Do I hear $" + lts(nw) + "?"
284. IF cr(2) + st(2).c >= nw THEN ce 8, "(Y/N)" ELSE ce 8, "press N to Not bid."
285. DO
286. LOOP UNTIL INKEY$ = ""
287. DO
288. yn$ = LCASE$(INKEY$)
289. LOOP UNTIL yn$ = "n" OR (yn$ = "y" AND cr(2) + st(2).c >= nw)
290. IF yn$ = "y" THEN
291. ce 10, " I hear $" + lts(nw)
292. nw = nw + bj
293. bidder = 2
294. ELSE
295. ce 9, "Going, going, going..."
296. END IF
297. clk .5
298. SELECT CASE bidder
299. CASE 0
300. ce 11, "No sale!"
301. p
302. CASE 1
303. pay 1, lwst
304. COLOR lot(st(t).whr).hue
305. ce 10, RTRIM$(lot(st(t).whr).ttl)
306. COLOR 15
307. lot(st(t).whr).own = 1
308. p
309. CASE 2
310. who = 1
311. DO
312. box
313. COLOR lot(st(t).whr).hue
314. ce 5, RTRIM$(lot(st(t).whr).ttl)
315. COLOR 15
316. ce 6, RTRIM$(st(who).ft) + ", you have $" + ltsb(st(who).c)
317. ce 7, "Do I hear $" + lts(nw) + "?"
318. IF cr(who) + st(who).c >= nw THEN ce 8, "(Y/N)" ELSE ce 8, "press N to Not bid."
319. DO
320. LOOP UNTIL INKEY$ = ""
321. DO
322. yn$ = LCASE$(INKEY$)
323. LOOP UNTIL yn$ = "n" OR (yn$ = "y" AND cr(who) + st(who).c >= nw)
324. IF yn$ = "y" THEN
325. ce 10, " I hear $" + lts(nw)
326. nw = nw + bj
327. bidder = who
328. ELSE
329. ce 9, "Going, going, going..."
330. done = -1
331. END IF
332. clk .5
333. who = 3 - who
334. LOOP UNTIL done
335. COLOR lot(st(t).whr).hue
336. ce 10, RTRIM$(lot(st(t).whr).ttl)
337. COLOR 15
338. pay bidder, nw - bj
339. lot(st(t).whr).own = bidder
340. p
341. END SELECT
342. END SUB
343.  
344. SUB b
345. DO
346. LOOP UNTIL INKEY$ = ""
347. FOR al = 300 TO 500 STEP 100
348. SOUND al, 2
349. NEXT
350. END SUB
351.  
352. SUB bca (t, houf, hotf)
353. hss = chou(t)
354. hts = chot(t)
355. ce 8, RTRIM$(st(t).ft) + ", you have " + lts(hss) + " house(s) and " + lts(hts) + " hotel(s)."
356. fee = hss * houf + hts * hotf
357. ce 9, "$" + lts(fee) + " due."
358. p
359. IF fee = 0 THEN EXIT SUB
360. pay t, fee
361. p
362. IF j THEN fr& = fr& + fee
363. END SUB
364.  
365. SUB box
366. COLOR 8
367. ce 4, CHR$(201) + STRING$(59, 205) + CHR$(187)
368. FOR sides = 5 TO 17
369. ce sides, CHR$(186) + SPACE$(59) + CHR$(186)
370. NEXT
371. ce 18, CHR$(204) + STRING$(8, 205) + CHR$(187) + SPACE$(50) + CHR$(186)
372. ce 19, CHR$(186) + SPACE$(8) + CHR$(186) + SPACE$(50) + CHR$(186)
373. ce 20, CHR$(200) + STRING$(8, 205) + CHR$(202) + STRING$(50, 205) + CHR$(188)
374. COLOR 6
375. LOCATE 19, 11
376. PRINT "JAIL:"
377. COLOR 15
378. IF st(1).whr = -10 THEN
379. LOCATE 19, 16
380. PRINT st(1).tk
381. END IF
382. IF st(2).whr = -10 THEN
383. LOCATE 19, 18
384. PRINT st(2).tk
385. END IF
386. IF (NOT x) THEN
387. LOCATE 18, 61
388. PRINT USING "houses:##"; bhu
389. END IF
390. IF (NOT x) THEN
391. LOCATE 19, 61
392. PRINT USING "hotels:##"; bht
393. END IF
394. END SUB
395.  
396. SUB broke (t)
397. DO
398. box
399. owe = ABS(st(t).c)
400. v = cr(t)
401. ce 5, RTRIM$(st(t).ft) + ", you need to raise $" + lts(ABS(owe))
402. ce 6, "You can raise $" + lts(v)
403. IF owe > v THEN
404. ce 12, "YOU ARE BROKE!!"
405. ce 16, "press Q to Quit game"
406. DO
407. LOOP UNTIL INKEY$ = ""
408. DO
409. done$ = LCASE$(INKEY$)
410. LOOP UNTIL done$ = "q"
411. gov 3 - t
412. END IF
413. ce 9, "press 4 to mortgage properties"
414. ce 10, "press 5 to sell houses"
415. ce 11, "press 6 to sell hotels"
416. ce 13, "press 8 to see inventories"
417. ce 14, "press 9 to view deeds"
418. ce 16, "press Q to Quit game"
419. DO
420. LOOP UNTIL INKEY$ = ""
421. DO
422. wtn$ = LCASE$(INKEY$)
423. wtn = VAL(wtn$)
424. LOOP UNTIL wtn$ > ""
425. IF wtn$ = "q" THEN quit
426. SELECT CASE wtn
427. CASE 4
428. mort t
429. CASE 5
430. shou t
431. swbs
432. CASE 6
433. shot t
434. swbs
435. CASE 8
436. inv
437. CASE 9
438. vwd
439. END SELECT
440. LOOP UNTIL st(t).c >= 0
441. box
442. END SUB
443.  
444. SUB buhot (t)
445. DIM gm(9)
446. gm(0) = -1
447. box
448. IF lot(1).own = t AND lot(1).stat = 4 AND st(t).c >= 50 AND bht > 0 THEN
449. gm(1) = -1
450. mini 1
451. END IF
452. IF lot(6).own = t AND lot(6).stat = 4 AND st(t).c >= 50 AND bht > 0 THEN
453. gm(2) = -1
454. mini 2
455. END IF
456. IF lot(11).own = t AND lot(11).stat = 4 AND st(t).c >= 100 AND bht > 0 THEN
457. gm(3) = -1
458. mini 3
459. END IF
460. IF lot(16).own = t AND lot(16).stat = 4 AND st(t).c >= 100 AND bht > 0 THEN
461. gm(4) = -1
462. mini 4
463. END IF
464. IF lot(21).own = t AND lot(21).stat = 4 AND st(t).c >= 150 AND bht > 0 THEN
465. gm(5) = -1
466. mini 5
467. END IF
468. IF lot(26).own = t AND lot(26).stat = 4 AND st(t).c >= 150 AND bht > 0 THEN
469. gm(6) = -1
470. mini 6
471. END IF
472. IF lot(31).own = t AND lot(31).stat = 4 AND st(t).c >= 200 AND bht > 0 THEN
473. gm(7) = -1
474. mini 7
475. END IF
476. IF lot(37).own = t AND lot(37).stat = 4 AND st(t).c >= 200 AND bht > 0 THEN
477. gm(8) = -1
478. mini 8
479. END IF
480. ce 9, RTRIM$(st(t).ft)
481. ce 10, "Choose a monopoly to buy hotels for"
482. ce 11, "or 0 to continue"
483. DO
484. IF wlb > 0 AND (NOT q) THEN b
485. DO
486. LOOP UNTIL INKEY$ = ""
487. DO
488. wlb$ = INKEY$
489. IF wlb$ = CHR$(13) THEN wlb$ = "0"
490. LOOP UNTIL wlb$ > ""
491. IF wlb$ >= "0" AND wlb$ <= "8" THEN wlb = VAL(wlb$) ELSE wlb = 9
492. LOOP UNTIL gm(wlb)
493. IF wlb = 0 THEN EXIT SUB
494. box
495. ce 5, RTRIM$(st(t).ft)
496. pim wlb, l, m, h
497. SELECT CASE m
498. CASE 2
499. IF lot(h).stat = 5 THEN max = 1 ELSE max = 2
500. CASE ELSE
501. max = 3
502. IF lot(h).stat = 5 THEN max = 2
503. IF lot(m).stat = 5 THEN max = 1
504. END SELECT
505. IF max > bht THEN max = bht
506. IF max > INT(st(t).c / lot(l).bc) THEN max = INT(st(t).c / lot(l).bc)
507. ce 7, "you can buy up to " + lts(max) + " hotel(s)."
508. ce 8, "or 0 to continue"
509. ce 10, "you have $" + ltsb(st(t).c)
510. ce 11, "hotels cost $" + lts(lot(l).bc) + " (plus four houses) each."
511. quan = ner(9, max)
512. IF quan = 0 THEN EXIT SUB
513. tot = lot(l).stat + lot(m).stat + lot(h).stat + quan
514. SELECT CASE m
515. CASE 2
516. lot(h).stat = INT(tot / 2)
517. lot(l).stat = INT(tot / 2)
518. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
519. CASE ELSE
520. lot(h).stat = INT(tot / 3)
521. lot(m).stat = INT(tot / 3)
522. lot(l).stat = INT(tot / 3)
523. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
524. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
525. END SELECT
526. pay t, lot(l).bc * quan
527. p
528. IF (NOT x) THEN
529. bht = bht - quan
530. bhu = bhu + quan * 4
531. END IF
532. END SUB
533.  
534. SUB buhou (t)
535. DIM gm(9)
536. gm(0) = -1
537. box
538. IF lot(1).own = t AND lot(1).mop AND (NOT lot(1).hk) AND (NOT lot(3).hk) AND lot(1).stat < 4 AND st(t).c >= 50 AND bhu > 0 THEN
539. gm(1) = -1
540. mini 1
541. END IF
542. IF lot(6).own = t AND lot(6).mop AND (NOT lot(6).hk) AND (NOT lot(8).hk) AND (NOT lot(9).hk) AND lot(6).stat < 4 AND st(t).c >= 50 AND bhu > 0 THEN
543. gm(2) = -1
544. mini 2
545. END IF
546. IF lot(11).own = t AND lot(11).mop AND (NOT lot(11).hk) AND (NOT lot(13).hk) AND (NOT lot(14).hk) AND lot(11).stat < 4 AND st(t).c >= 100 AND bhu > 0 THEN
547. gm(3) = -1
548. mini 3
549. END IF
550. IF lot(16).own = t AND lot(16).mop AND (NOT lot(16).hk) AND (NOT lot(18).hk) AND (NOT lot(19).hk) AND lot(16).stat < 4 AND st(t).c >= 100 AND bhu > 0 THEN
551. gm(4) = -1
552. mini 4
553. END IF
554. IF lot(21).own = t AND lot(21).mop AND (NOT lot(21).hk) AND (NOT lot(23).hk) AND (NOT lot(24).hk) AND lot(21).stat < 4 AND st(t).c >= 150 AND bhu > 0 THEN
555. gm(5) = -1
556. mini 5
557. END IF
558. IF lot(26).own = t AND lot(26).mop AND (NOT lot(26).hk) AND (NOT lot(27).hk) AND (NOT lot(29).hk) AND lot(26).stat < 4 AND st(t).c >= 150 AND bhu > 0 THEN
559. gm(6) = -1
560. mini 6
561. END IF
562. IF lot(31).own = t AND lot(31).mop AND (NOT lot(31).hk) AND (NOT lot(32).hk) AND (NOT lot(34).hk) AND lot(31).stat < 4 AND st(t).c >= 200 AND bhu > 0 THEN
563. gm(7) = -1
564. mini 7
565. END IF
566. IF lot(37).own = t AND lot(37).mop AND (NOT lot(37).hk) AND (NOT lot(39).hk) AND lot(37).stat < 4 AND st(t).c >= 200 AND bhu > 0 THEN
567. gm(8) = -1
568. mini 8
569. END IF
570. ce 9, RTRIM$(st(t).ft)
571. ce 10, "Choose a monopoly to buy houses for"
572. ce 11, "or 0 to continue"
573. DO
574. IF wlb > 0 AND (NOT q) THEN b
575. DO
576. LOOP UNTIL INKEY$ = ""
577. DO
578. wlb$ = INKEY$
579. IF wlb$ = CHR$(13) THEN wlb$ = "0"
580. LOOP UNTIL wlb$ > ""
581. IF wlb$ >= "0" AND wlb$ <= "8" THEN wlb = VAL(wlb$) ELSE wlb = 9
582. LOOP UNTIL gm(wlb)
583. IF wlb = 0 THEN EXIT SUB
584. box
585. ce 5, RTRIM$(st(t).ft)
586. pim wlb, l, m, h
587. SELECT CASE m
588. CASE 2
589. max = 8 - lot(l).stat - lot(h).stat
590. CASE ELSE
591. max = 12 - lot(l).stat - lot(m).stat - lot(h).stat
592. END SELECT
593. IF max > bhu THEN max = bhu
594. IF max > INT(st(t).c / lot(l).bc) THEN max = INT(st(t).c / lot(l).bc)
595. ce 7, "you can buy up to " + lts(max) + " house(s)."
596. ce 8, "or 0 to continue"
597. ce 10, "you have $" + ltsb(st(t).c)
598. ce 11, "houses cost $" + lts(lot(l).bc) + " each."
599. quan = ner(9, max)
600. IF quan = 0 THEN EXIT SUB
601. tot = lot(l).stat + lot(m).stat + lot(h).stat + quan
602. SELECT CASE m
603. CASE 2
604. lot(h).stat = INT(tot / 2)
605. lot(l).stat = INT(tot / 2)
606. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
607. CASE ELSE
608. lot(h).stat = INT(tot / 3)
609. lot(m).stat = INT(tot / 3)
610. lot(l).stat = INT(tot / 3)
611. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
612. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
613. END SELECT
614. pay t, lot(l).bc * quan
615. p
616. IF (NOT x) THEN bhu = bhu - quan
617. END SUB
618.  
619. SUB ce (dn, tx$)
620. LOCATE dn, 40 - INT(LEN(tx$) / 2)
621. PRINT tx$
622. END SUB
623.  
624. SUB chk (l, m, h)
625. IF lot(l).own = lot(m).own AND lot(m).own = lot(h).own AND lot(l).own > 0 THEN
626. lot(l).mop = -1
627. lot(m).mop = -1
628. lot(h).mop = -1
629. ELSE
630. lot(l).mop = 0
631. lot(m).mop = 0
632. lot(h).mop = 0
633. END IF
634. END SUB
635.  
636. FUNCTION chot (t)
637. FOR sq = 1 TO 39
638. IF lot(sq).sty = "b" AND lot(sq).own = t AND lot(sq).stat = 5 THEN ced = ced + 1
639. NEXT
640. chot = ced
641. END FUNCTION
642.  
643. FUNCTION chou (t)
644. FOR sq = 1 TO 39
645. IF lot(sq).sty = "b" AND lot(sq).own = t AND lot(sq).stat < 5 THEN ced = ced + lot(sq).stat
646. NEXT
647. chou = ced
648. END FUNCTION
649.  
650. SUB clk (se!)
651. start# = TIMER
652. DO
653. IF se! >= .1 THEN
654. DO
655. LOOP UNTIL INKEY$ = ""
656. END IF
657. LOOP UNTIL TIMER < start# OR TIMER - start# >= se!
658. END SUB
659.  
660. SUB cont (t, nos)
661. OPEN "monopoly.dat" FOR INPUT AS #1
662. IF (NOT nos) THEN
663. ce 5, "I found a save."
664. ce 7, "Do you want to continue prior game? (Y/N)"
665. DO
666. yn$ = LCASE$(INKEY$)
667. LOOP UNTIL yn$ = "y" OR yn$ = "n"
668. ce 8, UCASE$(yn$)
669. p
670. IF yn$ = "n" THEN
671. CLOSE
672. nos = -1
673. EXIT SUB
674. END IF
675. INPUT #1, sf!
676. IF sf! <> 1 AND sf! <> .5 THEN GOTO oops
677. INPUT #1, uf!
678. IF uf! <> .5 AND uf! <> .55 THEN GOTO oops
679. INPUT #1, t
680. IF t < 1 OR t > 2 THEN GOTO oops
681. INPUT #1, fr&
682. IF fr& < 0 THEN GOTO oops
683. INPUT #1, bhu
684. IF bhu < 0 OR bhu > 32 THEN GOTO oops
685. INPUT #1, bht
686. IF bht < 0 OR bht > 12 THEN GOTO oops
687. INPUT #1, j
688. IF j < -1 OR j > 0 THEN GOTO oops
689. INPUT #1, bn
690. IF bn < -1 OR bn > 0 THEN GOTO oops
691. INPUT #1, x
692. IF x < -1 OR x > 0 THEN GOTO oops
693. INPUT #1, q
694. IF q < -1 OR q > 0 THEN GOTO oops
695. FOR sq = 0 TO 39
696. INPUT #1, lot(sq).own
697. IF lot(sq).own < 0 OR lot(sq).own > 2 THEN GOTO oops
698. INPUT #1, lot(sq).stat
699. IF lot(sq).stat < 0 OR lot(sq).stat > 5 THEN GOTO oops
700. INPUT #1, lot(sq).mop
701. IF lot(sq).mop < -1 OR lot(sq).mop > 0 THEN GOTO oops
702. INPUT #1, lot(sq).hk
703. IF lot(sq).hk < -1 OR lot(sq).hk > 0 THEN GOTO oops
704. NEXT
705. FOR sq = 1 TO 2
706. INPUT #1, st(sq).ft
707. INPUT #1, st(sq).tk
708. INPUT #1, st(sq).c
709. IF st(sq).c < 0 THEN GOTO oops
710. INPUT #1, st(sq).whr
711. IF (st(sq).whr < 0 OR st(sq).whr > 39) AND st(sq).whr <> -10 THEN GOTO oops
712. INPUT #1, st(sq).jc
713. IF st(sq).jc < 0 OR st(sq).jc > 2 THEN GOTO oops
714. INPUT #1, st(sq).dc
715. IF st(sq).dc < 0 OR st(sq).dc > 2 THEN GOTO oops
716. INPUT #1, st(sq).chag
717. IF st(sq).chag < -1 OR st(sq).chag > 0 THEN GOTO oops
718. INPUT #1, st(sq).cheg
719. IF st(sq).cheg < -1 OR st(sq).cheg > 0 THEN GOTO oops
720. NEXT
721. FOR sq = 1 TO 16
722. INPUT #1, cha(sq)
723. IF cha(sq) < 0 OR cha(sq) > 2 THEN GOTO oops
724. INPUT #1, che(sq)
725. IF che(sq) < 0 OR che(sq) > 2 THEN GOTO oops
726. NEXT
727. CLOSE
728. KILL "monopoly.dat"
729. upd
730. END IF
731. EXIT SUB
732. oops:
733. ERROR 255
734. END SUB
735.  
736. FUNCTION cr (t)
737. FOR sq = 1 TO 39
738. IF lot(sq).own = t THEN
739. IF (NOT lot(sq).hk) THEN current = current + lot(sq).c / 2
740. IF lot(sq).sty = "b" THEN current = current + lot(sq).bc * lot(sq).stat * sf!
741. END IF
742. NEXT
743. cr = current
744. END FUNCTION
745.  
746. SUB crd
747. ce 12, "Program written by Brian H. Graham."
748. ce 13, "Based on the board game 'Monopoly' by Parker Brothers."
749. p
750. LOCATE 25, 1
751. COLOR 7
752. SYSTEM
753. END SUB
754.  
755. FUNCTION cw (t)
756. FOR sq = 1 TO 39
757. IF lot(sq).own = t THEN
758. IF lot(sq).hk THEN current = current + lot(sq).c / 2 ELSE current = current + lot(sq).c
759. IF lot(sq).sty = "b" THEN current = current + lot(sq).bc * lot(sq).stat
760. END IF
761. NEXT
762. cw = current + st(t).c
763. END FUNCTION
764.  
765. SUB dcha (t)
766. FOR look = 1 TO 16
767. IF cha(look) > 0 THEN ucha = ucha + 1
768. NEXT
769. IF ucha = 16 THEN scha
770. box
771. ce 5, RTRIM$(st(t).ft)
772. DO
773. cd = INT(RND * 16) + 1
774. LOOP UNTIL cha(cd) = 0
775. cha(cd) = 1
776. COLOR 12
777. ce 6, "Chance"
778. COLOR 15
779. SELECT CASE cd
780. CASE 1
781. ce 7, "Advance to Go. (Collect $200.)"
782. p
783. move 40 - st(t).whr, t
784. p
785. CASE 2
786. ce 7, "Advance to Illinois Avenue."
787. p
788. IF st(t).whr < 24 THEN move 24 - st(t).whr, t ELSE move 64 - st(t).whr, t
789. lop rl, t
790. CASE 3
791. ce 7, "Advance to the nearest Utility."
792. ce 8, "If it is owned, roll the dice,"
793. ce 9, "and pay the own ten times the amount shown."
794. ce 10, "If it is not owned, you may buy it."
795. p
796. SELECT CASE st(t).whr
797. CASE 7
798. move 12 - st(t).whr, t
799. CASE 22
800. move 28 - st(t).whr, t
801. CASE 36
802. move 52 - st(t).whr, t
803. END SELECT
804. utc t
805. CASE 4, 5
806. ce 7, "Advance to the next Railroad."
807. ce 8, "If it is owned, pay the own double"
808. ce 9, "the rent he/she is usually entitled."
809. ce 10, "If it is not owned, you may buy it."
810. p
811. SELECT CASE st(t).whr
812. CASE 7
813. move 15 - st(t).whr, t
814. CASE 22
815. move 25 - st(t).whr, t
816. CASE 36
817. move 45 - st(t).whr, t
818. END SELECT
819. rlc t
820. CASE 6
821. ce 7, "Advance to Saint Charles Place."
822. ce 8, "If you pass Go, collect $200."
823. p
824. IF st(t).whr < 11 THEN move 11 - st(t).whr, t ELSE move 51 - st(t).whr, t
825. lop rl, t
826. CASE 7
827. ce 7, "Bank pays you dividend of $50."
828. st(t).c = st(t).c + 50
829. p
830. CASE 8
831. ce 7, "Get out of Jail free."
832. ce 8, "This card may be kept until used or traded."
833. cha(8) = 2
834. st(t).chag = -1
835. p
836. CASE 9
837. ce 7, "Go back three spaces."
838. p
839. mob t
840. act rl, t
841. CASE 10
842. ce 7, "Go directly to Jail."
843. ce 8, "Do not pass Go, Do not collect $200."
844. p
845. ar t
846. CASE 11
847. ce 7, "Make general repairs on all you properties."
848. ce 8, "Pay $25 per house, $100 per hotel."
849. bca t, 25, 100
850. CASE 12
851. ce 7, "Pay poor tax of $15."
852. p
853. pay t, 15
854. IF j THEN fr& = fr& + 15
855. p
856. CASE 13
857. ce 7, "Take a ride on the Reading."
858. ce 8, "Advance to Reading Railroad."
859. ce 9, "Collect $200 if you pass Go."
860. p
861. move 45 - st(t).whr, t
862. lop rl, t
863. CASE 14
864. ce 7, "Take a walk on the boardwalk."
865. ce 8, "Advance to Boardwalk."
866. p
867. move 39 - st(t).whr, t
868. lop rl, t
869. CASE 15
870. ce 7, "You have been elected chairman of the board."
871. ce 8, "Pay each player $50."
872. p
873. popp t, 50
874. CASE 16
875. ce 7, "Your building and loan matures. Collect $150."
876. st(t).c = st(t).c + 150
877. p
878. END SELECT
879. END SUB
880.  
881. SUB dche (t)
882. FOR look = 1 TO 16
883. IF che(look) > 0 THEN uche = uche + 1
884. NEXT
885. IF uche = 16 THEN sche
886. box
887. ce 5, RTRIM$(st(t).ft)
888. DO
889. cd = INT(RND * 16) + 1
890. LOOP UNTIL che(cd) = 0
891. che(cd) = 1
892. COLOR 14
893. ce 6, "Community Chest"
894. COLOR 15
895. SELECT CASE cd
896. CASE 1
897. ce 7, "Advance to Go. (Collect $200.)"
898. p
899. move 40 - st(t).whr, t
900. p
901. CASE 2
902. ce 7, "Bank error in your favor. Collect $200."
903. p
904. st(t).c = st(t).c + 200
905. CASE 3
906. ce 7, "Christmas fund matures. Collect $100."
907. p
908. st(t).c = st(t).c + 100
909. CASE 4
910. ce 7, "Doctor's fee. Pay $50."
911. p
912. pay t, 50
913. p
914. IF j THEN fr& = fr& + 50
915. CASE 5
916. ce 7, "From sale of stock you get $45."
917. p
918. st(t).c = st(t).c + 45
919. CASE 6
920. ce 7, "Get out of Jail free."
921. ce 8, "This card may be kept until used or traded."
922. che(6) = 2
923. st(t).cheg = -1
924. p
925. CASE 7
926. ce 7, "Go directly to Jail."
927. ce 8, "Do not pass Go, Do not collect $200."
928. p
929. ar t
930. CASE 8
931. ce 7, "Grand opera opening. Collect $50 from every player."
932. p
933. popp 3 - t, 50
934. CASE 9
935. ce 7, "Income tax refund. Collect $20."
936. p
937. st(t).c = st(t).c + 20
938. CASE 10
939. ce 7, "Life insurance matures. Collect $100."
940. p
941. st(t).c = st(t).c + 100
942. CASE 11
943. ce 7, "Pay hospital $100."
944. p
945. pay t, 100
946. p
947. IF j THEN fr& = fr& + 100
948. CASE 12
949. ce 7, "Pay school tax of $150."
950. p
951. pay t, 150
952. p
953. IF j THEN fr& = fr& + 150
954. CASE 13
955. ce 7, "Recieve for services $25."
956. p
957. st(t).c = st(t).c + 25
958. CASE 14
959. ce 7, "You are assesed for street repairs."
960. ce 8, "$40 per house, $115 per hotel."
961. bca t, 40, 115
962. CASE 15
963. ce 7, "You have won second prize in a beauty contest."
964. ce 8, "Collect $10."
965. p
966. st(t).c = st(t).c + 10
967. CASE 16
968. ce 7, "You inherit $100."
969. p
970. st(t).c = st(t).c + 100
971. END SELECT
972. END SUB
973.  
974. FUNCTION di (d1, d2)
975. d1 = INT(RND * 6) + 1
976. d2 = INT(RND * 6) + 1
977. di = d1 + d2
978. ce 14, CHR$(218) + STRING$(5, 196) + CHR$(191) + CHR$(218) + STRING$(5, 196) + CHR$(191)
979. ce 15, top(d1) + top(d2)
980. ce 16, mdd(d1) + mdd(d2)
981. ce 17, bot(d1) + bot(d2)
982. ce 18, CHR$(192) + STRING$(5, 196) + CHR$(217) + CHR$(192) + STRING$(5, 196) + CHR$(217)
983. END FUNCTION
984.  
985. SUB dy (wt)
986. PRINT wt;
987. COLOR lot(wt).hue
988. PRINT lot(wt).ab;
989. COLOR 15
990. PRINT " $";
991. IF lot(wt).hk THEN PRINT lts(INT(.5 + lot(wt).c * uf!)) ELSE PRINT lts(lot(wt).c / 2)
992. END SUB
993.  
994. SUB fd (rl1, rl2, d1, d2, d3, d4)
995. d1 = INT(RND * 6) + 1
996. d2 = INT(RND * 6) + 1
997. d3 = INT(RND * 6) + 1
998. d4 = INT(RND * 6) + 1
999. rl1 = d1 + d2
1000. rl2 = d3 + d4
1001. ce 13, RTRIM$(st(1).ft) + SPACE$(6) + RTRIM$(st(2).ft)
1002. ce 14, CHR$(218) + STRING$(5, 196) + CHR$(191) + CHR$(218) + STRING$(5, 196) + CHR$(191) + SPACE$(6) + CHR$(218) + STRING$(5, 196) + CHR$(191) + CHR$(218) + STRING$(5, 196) + CHR$(191)
1003. ce 15, top(d1) + top(d2) + SPACE$(6) + top(d3) + top(d4)
1004. ce 16, mdd(d1) + mdd(d2) + SPACE$(6) + mdd(d3) + mdd(d4)
1005. ce 17, bot(d1) + bot(d2) + SPACE$(6) + bot(d3) + bot(d4)
1006. ce 18, CHR$(192) + STRING$(5, 196) + CHR$(217) + CHR$(192) + STRING$(5, 196) + CHR$(217) + SPACE$(6) + CHR$(192) + STRING$(5, 196) + CHR$(217) + CHR$(192) + STRING$(5, 196) + CHR$(217)
1007. END SUB
1008.  
1009. SUB gov (t)
1010. st(1).whr = 0
1011. st(2).whr = 0
1012. x = -1
1013. CLS
1014. swbd
1015. IF t = 0 THEN
1016. ce 5, "This game was a tie!"
1017. ce 7, "Thank you for playing " + RTRIM$(st(1).ft) + " and " + RTRIM$(st(2).ft)
1018. ELSE
1019. ce 5, RTRIM$(st(t).ft) + " has won!!!"
1020. ce 8, "Better luck next time " + RTRIM$(st(3 - t).ft)
1021. END IF
1022. crd
1023. END SUB
1024.  
1025. SUB inc (t)
1026. box
1027. ce 5, RTRIM$(st(t).ft)
1028. ce 6, "Income Tax"
1029. ce 8, "press W to pay 10% of your Worth"
1030. ce 9, "press F to pay $200 Flat rate"
1031. DO
1032. LOOP UNTIL INKEY$ = ""
1033. DO
1034. taxopt$ = LCASE$(INKEY$)
1035. LOOP UNTIL taxopt$ = "f" OR taxopt$ = "w"
1036. IF taxopt$ = "f" THEN fee = 200 ELSE fee = INT(.5 + cw(t) / 10)
1037. ce 10, UCASE$(taxopt$) + ", $" + lts(fee) + " due."
1038. p
1039. pay t, fee
1040. p
1041. IF j THEN fr& = fr& + fee
1042. END SUB
1043.  
1044. SUB init
1045. alto$ = CHR$(2) + CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6) + CHR$(21) + CHR$(157) + CHR$(232) + CHR$(233) + CHR$(236)
1046. FOR wide = 1 TO 10
1047. wide$ = wide$ + MID$(alto$, wide, 1) + " "
1048. NEXT
1049. wide$ = RTRIM$(wide$)
1050. FOR sq = 1 TO 2
1051. DO
1052. box
1053. ce 5, "Player " + lts(sq) + " first name"
1054. who$ = ""
1055. DO
1056. ltr$ = txk
1057. IF ltr$ = CHR$(8) AND LEN(who$) > 0 THEN
1058. who$ = LEFT$(who$, (LEN(who$) - 1))
1059. ELSE
1060. IF ltr$ <> CHR$(13) AND ltr$ <> CHR$(8) THEN who$ = who$ + ltr$
1061. END IF
1062. IF LEN(who$) < 9 THEN
1063. ce 6, SPACE$(10)
1064. ce 6, who$
1065. END IF
1066. LOOP UNTIL ltr$ = CHR$(13) OR LEN(who$) = 10
1067. st(sq).ft = who$
1068. LOOP UNTIL st(1).ft <> st(2).ft AND st(sq).ft <> SPACE$(8)
1069. ce 7, "pick a token"
1070. ce 8, wide$
1071. ce 9, "1 2 3 4 5 6 7 8 9 0"
1072. IF hide > 0 THEN
1073. LOCATE 8, hide * 2 + 29
1074. PRINT " "
1075. LOCATE 9, hide * 2 + 29
1076. PRINT " "
1077. END IF
1078. DO
1079. LOOP UNTIL INKEY$ = ""
1080. DO
1081. pick$ = INKEY$
1082. pick = VAL(pick$)
1083. IF pick = 0 THEN pick = 10
1084. LOOP UNTIL pick$ >= "0" AND pick$ <= "9" AND pick <> hide
1085. hide = pick
1086. st(sq).tk = MID$(alto$, hide, 1)
1087. st(sq).c = 1500
1088. ce 11, lts(pick) + ", " + st(sq).tk
1089. p
1090. NEXT
1091. DO
1092. box
1093. fd rl1, rl2, d1, d2, d3, d4
1094. ce 5, "Determining who goes first:"
1095. ce 7, RTRIM$(st(1).ft) + " rolls " + lts(d1) + " + " + lts(d2) + " = " + lts(rl1)
1096. ce 8, RTRIM$(st(2).ft) + " rolls " + lts(d3) + " + " + lts(d4) + " + " + lts(rl2)
1097. IF rl1 = rl2 THEN
1098. ce 10, "No decision. I will try again."
1099. p
1100. END IF
1101. LOOP UNTIL rl1 <> rl2
1102. IF rl2 > rl1 THEN SWAP st(1), st(2)
1103. ce 10, "This means " + RTRIM$(st(1).ft) + " goes first."
1104. p
1105. END SUB
1106.  
1107. SUB inv
1108. FOR look = 0 TO 2
1109. box
1110. IF lot(1).own = look THEN
1111. LOCATE 5, 11
1112. lil 1
1113. END IF
1114. IF lot(3).own = look THEN
1115. LOCATE 6, 11
1116. lil 3
1117. END IF
1118. IF lot(5).own = look THEN
1119. LOCATE 7, 11
1120. lil 5
1121. END IF
1122. IF lot(6).own = look THEN
1123. LOCATE 8, 11
1124. lil 6
1125. END IF
1126. IF lot(8).own = look THEN
1127. LOCATE 9, 11
1128. lil 8
1129. END IF
1130. IF lot(9).own = look THEN
1131. LOCATE 10, 11
1132. lil 9
1133. END IF
1134. IF lot(11).own = look THEN
1135. LOCATE 5, 26
1136. lil 11
1137. END IF
1138. IF lot(12).own = look THEN
1139. LOCATE 6, 26
1140. lil 12
1141. END IF
1142. IF lot(13).own = look THEN
1143. LOCATE 7, 26
1144. lil 13
1145. END IF
1146. IF lot(14).own = look THEN
1147. LOCATE 8, 26
1148. lil 14
1149. END IF
1150. IF lot(15).own = look THEN
1151. LOCATE 9, 26
1152. lil 15
1153. END IF
1154. IF lot(16).own = look THEN
1155. LOCATE 10, 26
1156. lil 16
1157. END IF
1158. IF lot(18).own = look THEN
1159. LOCATE 11, 26
1160. lil 18
1161. END IF
1162. IF lot(19).own = look THEN
1163. LOCATE 12, 26
1164. lil 19
1165. END IF
1166. IF lot(21).own = look THEN
1167. LOCATE 5, 41
1168. lil 21
1169. END IF
1170. IF lot(23).own = look THEN
1171. LOCATE 6, 41
1172. lil 23
1173. END IF
1174. IF lot(24).own = look THEN
1175. LOCATE 7, 41
1176. lil 24
1177. END IF
1178. IF lot(25).own = look THEN
1179. LOCATE 8, 41
1180. lil 25
1181. END IF
1182. IF lot(26).own = look THEN
1183. LOCATE 9, 41
1184. lil 26
1185. END IF
1186. IF lot(27).own = look THEN
1187. LOCATE 10, 41
1188. lil 27
1189. END IF
1190. IF lot(28).own = look THEN
1191. LOCATE 11, 41
1192. lil 28
1193. END IF
1194. IF lot(29).own = look THEN
1195. LOCATE 12, 41
1196. lil 29
1197. END IF
1198. IF lot(31).own = look THEN
1199. LOCATE 5, 56
1200. lil 31
1201. END IF
1202. IF lot(32).own = look THEN
1203. LOCATE 6, 56
1204. lil 32
1205. END IF
1206. IF lot(34).own = look THEN
1207. LOCATE 7, 56
1208. lil 34
1209. END IF
1210. IF lot(35).own = look THEN
1211. LOCATE 8, 56
1212. lil 35
1213. END IF
1214. IF lot(37).own = look THEN
1215. LOCATE 9, 56
1216. lil 37
1217. END IF
1218. IF lot(39).own = look THEN
1219. LOCATE 10, 56
1220. lil 39
1221. END IF
1222. SELECT CASE look
1223. CASE 0
1224. ce 14, "unowned properties"
1225. IF j THEN ce 16, "Free Parking has $" + ltsb(fr&)
1226. CASE 1, 2
1227. IF st(look).chag THEN
1228. COLOR 12
1229. LOCATE 12, 11
1230. PRINT "GOOJF";
1231. COLOR 15
1232. PRINT " Chance"
1233. END IF
1234. IF st(look).cheg THEN
1235. COLOR 14
1236. LOCATE 12, 56
1237. PRINT "GOOJF";
1238. COLOR 15
1239. PRINT " Cm Chst"
1240. END IF
1241. ce 14, RTRIM$(st(look).ft) + ", your properties"
1242. ce 15, "you are the " + st(look).tk
1243. IF st(look).c >= 0 THEN ce 16, "you have $" + ltsb(st(look).c) ELSE ce 16, "you need to raise $" + lts(ABS(st(look).c))
1244. END SELECT
1245. p
1246. NEXT
1247. END SUB
1248.  
1249. SUB lil (wt)
1250. COLOR lot(wt).hue
1251. PRINT lot(wt).ab;
1252. COLOR 15
1253. IF lot(wt).hk THEN
1254. PRINT " mort"
1255. ELSE
1256. IF lot(wt).own > 0 THEN
1257. SELECT CASE lot(wt).stat
1258. CASE 0
1259. IF lot(wt).mop THEN PRINT " doubl" ELSE PRINT " plain"
1260. CASE 1
1261. SELECT CASE lot(wt).sty
1262. CASE "b"
1263. PRINT " 1 hse"
1264. CASE "r"
1265. PRINT " 1 rr"
1266. CASE "u"
1267. PRINT " 1 utl"
1268. END SELECT
1269. CASE 2
1270. SELECT CASE lot(wt).sty
1271. CASE "b"
1272. PRINT " 2 hses"
1273. CASE "r"
1274. PRINT " 2 rrs"
1275. CASE "u"
1276. PRINT " 2 utls"
1277. END SELECT
1278. CASE 3
1279. SELECT CASE lot(wt).sty
1280. CASE "b"
1281. PRINT " 3 hses"
1282. CASE "r"
1283. PRINT " 3 rrs"
1284. END SELECT
1285. CASE 4
1286. SELECT CASE lot(wt).sty
1287. CASE "b"
1288. PRINT " 4 hses"
1289. CASE "r"
1290. PRINT " 4 rrs"
1291. END SELECT
1292. CASE 5
1293. PRINT " hotel"
1294. END SELECT
1295. END IF
1296. END IF
1297. END SUB
1298.  
1299. SUB lop (rl, t)
1300. IF lot(st(t).whr).own = 0 THEN
1301. noo t
1302. EXIT SUB
1303. END IF
1304. IF lot(st(t).whr).own = t THEN
1305. COLOR lot(st(t).whr).hue
1306. ce 12, RTRIM$(lot(st(t).whr).ttl)
1307. COLOR 15
1308. ce 13, "is yours."
1309. p
1310. EXIT SUB
1311. END IF
1312. IF lot(st(t).whr).hk THEN
1313. COLOR lot(st(t).whr).hue
1314. ce 12, RTRIM$(lot(st(t).whr).ttl)
1315. COLOR 15
1316. ce 13, "is mortgaged."
1317. p
1318. EXIT SUB
1319. END IF
1320. SELECT CASE lot(st(t).whr).stat
1321. CASE 0
1322. IF lot(st(t).whr).mop THEN popp t, lot(st(t).whr).r * 2 ELSE popp t, lot(st(t).whr).r
1323. CASE 1
1324. IF lot(st(t).whr).sty = "u" THEN popp t, 4 * rl ELSE popp t, lot(st(t).whr).r1
1325. CASE 2
1326. IF lot(st(t).whr).sty = "u" THEN popp t, 10 * rl ELSE popp t, lot(st(t).whr).r2
1327. CASE 3
1328. popp t, lot(st(t).whr).r3
1329. CASE 4
1330. popp t, lot(st(t).whr).r4
1331. CASE 5
1332. popp t, lot(st(t).whr).rhot
1333. END SELECT
1334. END SUB
1335.  
1336. FUNCTION lts$ (nu)
1337. lts = LTRIM$(STR$(nu))
1338. END FUNCTION
1339.  
1340. FUNCTION ltsb$ (nu&)
1341. ltsb = LTRIM$(STR$(nu&))
1342. END FUNCTION
1343.  
1344. SUB mb
1345. FOR sq = 0 TO 39
1346. READ lot(sq).ttl
1347. READ lot(sq).ab
1348. READ lot(sq).sty
1349. READ lot(sq).c
1350. READ lot(sq).r
1351. READ lot(sq).r1
1352. READ lot(sq).r2
1353. READ lot(sq).r3
1354. READ lot(sq).r4
1355. READ lot(sq).rhot
1356. READ lot(sq).bc
1357. READ lot(sq).hue
1358. READ lot(sq).od
1359. READ lot(sq).oa
1360. READ lot(sq).id
1361. READ lot(sq).ia
1362. READ lot(sq).bdn
1363. READ lot(sq).bac
1364. NEXT
1365. END SUB
1366.  
1367. SUB md
1368. p0$ = CHR$(179) + SPACE$(5) + CHR$(179)
1369. p1a$ = CHR$(179) + "@" + SPACE$(4) + CHR$(179)
1370. p1b$ = CHR$(179) + SPACE$(2) + "@" + SPACE$(2) + CHR$(179)
1371. p1c$ = CHR$(179) + SPACE$(4) + "@" + CHR$(179)
1372. p2$ = CHR$(179) + "@" + SPACE$(3) + "@" + CHR$(179)
1373. top(1) = p0$
1374. mdd(1) = p1b$
1375. bot(1) = p0$
1376. top(2) = p1a$
1377. mdd(2) = p0$
1378. bot(2) = p1c$
1379. top(3) = p1a$
1380. mdd(3) = p1b$
1381. bot(3) = p1c$
1382. top(4) = p2$
1383. mdd(4) = p0$
1384. bot(4) = p2$
1385. top(5) = p2$
1386. mdd(5) = p1b$
1387. bot(5) = p2$
1388. top(6) = p2$
1389. mdd(6) = p2$
1390. bot(6) = p2$
1391. END SUB
1392.  
1393. SUB mini (gr)
1394. SELECT CASE gr
1395. CASE 1
1396. dn = 5
1397. ac = 11
1398. mophue = 5
1399. mopstr$ = "MEDIT/BALTI"
1400. CASE 2
1401. dn = 6
1402. ac = 11
1403. mophue = 11
1404. mopstr$ = "OREIN/VERMO/CONNE"
1405. CASE 3
1406. dn = 7
1407. ac = 11
1408. mophue = 13
1409. mopstr$ = "STCHA/STATE/VIRGI"
1410. CASE 4
1411. dn = 8
1412. ac = 11
1413. mophue = 12
1414. mopstr$ = "STJAM/TENNE/NEWYO"
1415. CASE 5
1416. dn = 5
1417. ac = 41
1418. mophue = 4
1419. mopstr$ = "KENTU/INDIA/ILLIN"
1420. CASE 6
1421. dn = 6
1422. ac = 41
1423. mophue = 14
1424. mopstr$ = "ATLAN/VENTN/MARVI"
1425. CASE 7
1426. dn = 7
1427. ac = 41
1428. mophue = 10
1429. mopstr$ = "PACIF/NORTH/PENAV"
1430. CASE 8
1431. dn = 8
1432. ac = 41
1433. mophue = 9
1434. mopstr$ = "PARKP/BOARD"
1435. END SELECT
1436. LOCATE dn, ac
1437. PRINT gr;
1438. COLOR mophue
1439. PRINT mopstr$
1440. COLOR 15
1441. END SUB
1442.  
1443. SUB mob (t)
1444. FOR sq = 0 TO 2
1445. IF t = 1 THEN LOCATE lot(st(1).whr - sq).od, lot(st(1).whr - sq).oa ELSE LOCATE lot(st(2).whr - sq).id, lot(st(2).whr - sq).ia
1446. PRINT " "
1447. IF t = 1 THEN LOCATE lot(st(1).whr - sq - 1).od, lot(st(1).whr - sq - 1).oa ELSE LOCATE lot(st(2).whr - sq - 1).id, lot(st(2).whr - sq - 1).ia
1448. PRINT st(t).tk
1449. clk .1
1450. NEXT
1451. st(t).whr = (st(t).whr - 3)
1452. END SUB
1453.  
1454. SUB more (t)
1455. DO
1456. box
1457. ce 5, RTRIM$(st(t).ft) + ", you have $" + ltsb(st(t).c)
1458. ce 6, "press 1 to unmortgage properties"
1459. ce 7, "press 2 to buy houses"
1460. ce 8, "press 3 to buy hotels"
1461. ce 9, "press 4 to mortgage properties"
1462. ce 10, "press 5 to sell houses"
1463. ce 11, "press 6 to sell hotels"
1464. ce 12, "press 7 to trade"
1465. ce 13, "press 8 to see inventories"
1466. ce 14, "press 9 to view deeds"
1467. ce 15, "press any other key to continue"
1468. wtn = VAL(ak)
1469. SELECT CASE wtn
1470. CASE 1
1471. unm t
1472. CASE 2
1473. buhou t
1474. swbs
1475. CASE 3
1476. buhot t
1477. swbs
1478. CASE 4
1479. mort t
1480. CASE 5
1481. shou t
1482. swbs
1483. CASE 6
1484. shot t
1485. swbs
1486. CASE 7
1487. trade
1488. upd
1489. CASE 8
1490. inv
1491. CASE 9
1492. vwd
1493. END SELECT
1494. LOOP UNTIL wtn = 0
1495. END SUB
1496.  
1497. SUB mort (t)
1498. DIM gp(39)
1499. gp(0) = -1
1500. box
1501. IF lot(1).own = t AND (NOT lot(1).hk) AND lot(3).stat = 0 THEN
1502. LOCATE 5, 11
1503. dy 1
1504. gp(1) = -1
1505. END IF
1506. IF lot(3).own = t AND (NOT lot(3).hk) AND lot(3).stat = 0 THEN
1507. LOCATE 6, 11
1508. dy 3
1509. gp(3) = -1
1510. END IF
1511. IF lot(5).own = t AND (NOT lot(5).hk) THEN
1512. LOCATE 7, 11
1513. dy 5
1514. gp(5) = -1
1515. END IF
1516. IF lot(6).own = t AND (NOT lot(6).hk) AND lot(9).stat = 0 THEN
1517. LOCATE 8, 11
1518. dy 6
1519. gp(6) = -1
1520. END IF
1521. IF lot(8).own = t AND (NOT lot(8).hk) AND lot(9).stat = 0 THEN
1522. LOCATE 9, 11
1523. dy 8
1524. gp(8) = -1
1525. END IF
1526. IF lot(9).own = t AND (NOT lot(9).hk) AND lot(9).stat = 0 THEN
1527. LOCATE 10, 11
1528. dy 9
1529. gp(9) = -1
1530. END IF
1531. IF lot(11).own = t AND (NOT lot(11).hk) AND lot(14).stat = 0 THEN
1532. LOCATE 5, 26
1533. dy 11
1534. gp(11) = -1
1535. END IF
1536. IF lot(12).own = t AND (NOT lot(12).hk) THEN
1537. LOCATE 6, 26
1538. dy 12
1539. gp(12) = -1
1540. END IF
1541. IF lot(13).own = t AND (NOT lot(13).hk) AND lot(14).stat = 0 THEN
1542. LOCATE 7, 26
1543. dy 13
1544. gp(13) = -1
1545. END IF
1546. IF lot(14).own = t AND (NOT lot(14).hk) AND lot(14).stat = 0 THEN
1547. LOCATE 8, 26
1548. dy 14
1549. gp(14) = -1
1550. END IF
1551. IF lot(15).own = t AND (NOT lot(15).hk) THEN
1552. LOCATE 9, 26
1553. dy 15
1554. gp(15) = -1
1555. END IF
1556. IF lot(16).own = t AND (NOT lot(16).hk) AND lot(19).stat = 0 THEN
1557. LOCATE 10, 26
1558. dy 16
1559. gp(16) = -1
1560. END IF
1561. IF lot(18).own = t AND (NOT lot(18).hk) AND lot(19).stat = 0 THEN
1562. LOCATE 11, 26
1563. dy 18
1564. gp(18) = -1
1565. END IF
1566. IF lot(19).own = t AND (NOT lot(19).hk) AND lot(19).stat = 0 THEN
1567. LOCATE 12, 26
1568. dy 19
1569. gp(19) = -1
1570. END IF
1571. IF lot(21).own = t AND (NOT lot(21).hk) AND lot(24).stat = 0 THEN
1572. LOCATE 5, 41
1573. dy 21
1574. gp(21) = -1
1575. END IF
1576. IF lot(23).own = t AND (NOT lot(23).hk) AND lot(24).stat = 0 THEN
1577. LOCATE 6, 41
1578. dy 23
1579. gp(23) = -1
1580. END IF
1581. IF lot(24).own = t AND (NOT lot(24).hk) AND lot(24).stat = 0 THEN
1582. LOCATE 7, 41
1583. dy 24
1584. gp(24) = -1
1585. END IF
1586. IF lot(25).own = t AND (NOT lot(25).hk) THEN
1587. LOCATE 8, 41
1588. dy 25
1589. gp(25) = -1
1590. END IF
1591. IF lot(26).own = t AND (NOT lot(26).hk) AND lot(29).stat = 0 THEN
1592. LOCATE 9, 41
1593. dy 26
1594. gp(26) = -1
1595. END IF
1596. IF lot(27).own = t AND (NOT lot(27).hk) AND lot(29).stat = 0 THEN
1597. LOCATE 10, 41
1598. dy 27
1599. gp(27) = -1
1600. END IF
1601. IF lot(28).own = t AND (NOT lot(28).hk) THEN
1602. LOCATE 11, 41
1603. dy 28
1604. gp(28) = -1
1605. END IF
1606. IF lot(29).own = t AND (NOT lot(29).hk) AND lot(29).stat = 0 THEN
1607. LOCATE 12, 41
1608. dy 29
1609. gp(29) = -1
1610. END IF
1611. IF lot(31).own = t AND (NOT lot(31).hk) AND lot(34).stat = 0 THEN
1612. LOCATE 5, 56
1613. dy 31
1614. gp(31) = -1
1615. END IF
1616. IF lot(32).own = t AND (NOT lot(32).hk) AND lot(34).stat = 0 THEN
1617. LOCATE 6, 56
1618. dy 32
1619. gp(32) = -1
1620. END IF
1621. IF lot(34).own = t AND (NOT lot(34).hk) AND lot(34).stat = 0 THEN
1622. LOCATE 7, 56
1623. dy 34
1624. gp(34) = -1
1625. END IF
1626. IF lot(35).own = t AND (NOT lot(35).hk) THEN
1627. LOCATE 8, 56
1628. dy 35
1629. gp(35) = -1
1630. END IF
1631. IF lot(37).own = t AND (NOT lot(37).hk) AND lot(39).stat = 0 THEN
1632. LOCATE 9, 56
1633. dy 37
1634. gp(37) = -1
1635. END IF
1636. IF lot(39).own = t AND (NOT lot(39).hk) AND lot(39).stat = 0 THEN
1637. LOCATE 10, 56
1638. dy 39
1639. gp(39) = -1
1640. END IF
1641. ce 13, RTRIM$(st(t).ft)
1642. ce 14, "Choose a deed to mortgage or 0 to continue"
1643. IF st(t).c >= 0 THEN ce 17, "you have $" + ltsb(st(t).c) ELSE ce 17, "you need to raise $" + lts(-st(t).c)
1644. DO
1645. IF (NOT gp(pick)) AND (NOT q) THEN b
1646. pick = ner(15, 39)
1647. LOOP UNTIL gp(pick)
1648. IF pick = 0 THEN EXIT SUB
1649. lot(pick).hk = -1
1650. st(t).c = st(t).c + lot(pick).c / 2
1651. END SUB
1652.  
1653. SUB move (dist, t)
1654. FOR sq = 0 TO dist - 1
1655. IF t = 1 THEN LOCATE lot((st(1).whr + sq) MOD 40).od, lot((st(1).whr + sq) MOD 40).oa ELSE LOCATE lot((st(2).whr + sq) MOD 40).id, lot((st(2).whr + sq) MOD 40).ia
1656. PRINT " "
1657. IF t = 1 THEN LOCATE lot((st(1).whr + sq + 1) MOD 40).od, lot((st(1).whr + sq + 1) MOD 40).oa ELSE LOCATE lot((st(2).whr + sq + 1) MOD 40).id, lot((st(2).whr + sq + 1) MOD 40).ia
1658. PRINT st(t).tk
1659. clk .1
1660. NEXT
1661. IF st(t).whr + dist >= 40 THEN st(t).c = st(t).c + 200
1662. IF st(t).whr + dist > 40 THEN
1663. box
1664. ce 5, RTRIM$(st(t).ft) + ", you collect $200 for passing Go."
1665. clk .9
1666. END IF
1667. st(t).whr = (st(t).whr + dist) MOD 40
1668. END SUB
1669.  
1670. FUNCTION ner (dn, max)
1671. IF max = 0 THEN mk = 2 ELSE mk = INT(LOG(max) / LOG(10)) + 2
1672. DO
1673. ce dn, SPACE$(10)
1674. IF num > 0 AND (NOT q) THEN b
1675. num = 0
1676. num$ = ""
1677. DO
1678. numk$ = nerk
1679. IF numk$ = CHR$(8) AND LEN(num$) > 0 THEN
1680. num$ = LEFT$(num$, (LEN(num$) - 1))
1681. ELSE
1682. IF numk$ <> CHR$(13) AND numk$ <> CHR$(8) THEN num$ = num$ + numk$
1683. END IF
1684. IF LEN(num$) < mk THEN
1685. ce dn, SPACE$(10)
1686. ce dn, num$
1687. END IF
1688. LOOP UNTIL numk$ = CHR$(13) OR LEN(num$) = mk
1689. num = VAL(num$)
1690. LOOP UNTIL num <= max
1691. ner = num
1692. END FUNCTION
1693.  
1694. FUNCTION nerb& (dn, max&)
1695. IF max& = 0 THEN mk = 2 ELSE mk = INT(LOG(max&) / LOG(10)) + 2
1696. DO
1697. ce dn, SPACE$(10)
1698. IF num& > 0 AND (NOT q) THEN b
1699. num& = 0
1700. num$ = ""
1701. DO
1702. numk$ = nerk
1703. IF numk$ = CHR$(8) AND LEN(num$) > 0 THEN
1704. num$ = LEFT$(num$, (LEN(num$) - 1))
1705. ELSE
1706. IF numk$ <> CHR$(13) AND numk$ <> CHR$(8) THEN num$ = num$ + numk$
1707. END IF
1708. IF LEN(num$) < mk THEN
1709. ce dn, SPACE$(10)
1710. ce dn, num$
1711. END IF
1712. LOOP UNTIL numk$ = CHR$(13) OR LEN(num$) = mk
1713. num& = VAL(num$)
1714. LOOP UNTIL num& <= max&
1715. nerb& = num&
1716. END FUNCTION
1717.  
1718. FUNCTION nerk$
1719. DO
1720. DO
1721. LOOP UNTIL INKEY$ = ""
1722. DO
1723. tx$ = INKEY$
1724. LOOP UNTIL tx$ > ""
1725. SELECT CASE tx$
1726. CASE "0" TO "9", CHR$(13), CHR$(8)
1727. valid = -1
1728. CASE ELSE
1729. valid = 0
1730. IF (NOT q) THEN b
1731. END SELECT
1732. LOOP UNTIL valid
1733. nerk = tx$
1734. END FUNCTION
1735.  
1736. SUB noo (t)
1737. box
1738. COLOR lot(st(t).whr).hue
1739. ce 5, RTRIM$(lot(st(t).whr).ttl)
1740. COLOR 7
1741. ce 6, "cost $" + lts(lot(st(t).whr).c)
1742. ce 7, "mortgage value $" + lts(lot(st(t).whr).c / 2)
1743. SELECT CASE lot(st(t).whr).sty
1744. CASE "b"
1745. ce 8, "rent $" + lts(lot(st(t).whr).r)
1746. ce 9, "rent with one house $" + lts(lot(st(t).whr).r1)
1747. ce 10, "rent with two houses $" + lts(lot(st(t).whr).r2)
1748. ce 11, "rent with three houses $" + lts(lot(st(t).whr).r3)
1749. ce 12, "rent with four houses $" + lts(lot(st(t).whr).r4)
1750. ce 13, "rent with hotel $" + lts(lot(st(t).whr).rhot)
1751. ce 14, "houses cost $" + lts(lot(st(t).whr).bc) + " each"
1752. ce 15, "hotel costs $" + lts(lot(st(t).whr).bc) + " plus 4 houses"
1753. COLOR 15
1754. CASE "u"
1755. COLOR 15
1756. ce 8, "rent with one Utility, four times dice"
1757. ce 9, "rent with two Utilities, ten times dice"
1758. CASE "r"
1759. COLOR 15
1760. ce 8, "rent with one Railroad $25"
1761. ce 9, "rent with two Railroads $50"
1762. ce 10, "rent with three Railroads $100"
1763. ce 11, "rent with four Railroads $200"
1764. END SELECT
1765. ce 16, RTRIM$(st(t).ft) + ", you have $" + ltsb(st(t).c)
1766. IF cr(t) + st(t).c >= lot(st(t).whr).c THEN ce 17, "press B to Buy"
1767. ce 18, "press A to Auction"
1768. DO
1769. LOOP UNTIL INKEY$ = ""
1770. DO
1771. wt$ = LCASE$(INKEY$)
1772. LOOP UNTIL wt$ = "a" OR (wt$ = "b" AND cr(t) + st(t).c >= lot(st(t).whr).c)
1773. box
1774. IF wt$ = "b" THEN
1775. pay t, lot(st(t).whr).c
1776. COLOR lot(st(t).whr).hue
1777. ce 10, RTRIM$(lot(st(t).whr).ttl)
1778. COLOR 15
1779. lot(st(t).whr).own = t
1780. p
1781. ELSE
1782. auc t
1783. END IF
1784. upd
1785. END SUB
1786.  
1787. SUB opt (t)
1788. DO
1789. box
1790. ce 5, RTRIM$(st(t).ft) + ", you have $" + ltsb(st(t).c)
1791. ce 6, "press P for Property options"
1792. ce 7, "press S to Save and exit"
1793. ce 8, "press Q to Quit game early"
1794. ce 9, "press any other key to continue"
1795. wt$ = ak
1796. SELECT CASE wt$
1797. CASE "s"
1798. save t
1799. CASE "p"
1800. more t
1801. CASE "q"
1802. quit
1803. CASE ELSE
1804. done = -1
1805. END SELECT
1806. LOOP UNTIL done
1807. END SUB
1808.  
1809. SUB p
1810. ce 19, "press any key."
1811. DO
1812. LOOP UNTIL INKEY$ > ""
1813. ce 19, SPACE$(14)
1814. END SUB
1815.  
1816. SUB pay (t, cge)
1817. st(t).c = st(t).c - cge
1818. IF st(t).c < 0 THEN broke t
1819. ce 12, RTRIM$(st(t).ft) + " paid $" + lts(cge)
1820. END SUB
1821.  
1822. SUB pim (gr, l, m, h)
1823. SELECT CASE gr
1824. CASE 1
1825. l = 1
1826. m = 2
1827. h = 3
1828. COLOR 5
1829. ce 6, "MEDIT/BALTI"
1830. CASE 2
1831. l = 6
1832. m = 8
1833. h = 9
1834. COLOR 11
1835. ce 6, "OREIN/VERMO/CONNE"
1836. CASE 3
1837. l = 11
1838. m = 13
1839. h = 14
1840. COLOR 13
1841. ce 6, "STCHA/STATE/VIRGI"
1842. CASE 4
1843. l = 16
1844. m = 18
1845. h = 19
1846. COLOR 12
1847. ce 6, "STJAM/TENNE/NEWYO"
1848. CASE 5
1849. l = 21
1850. m = 23
1851. h = 24
1852. COLOR 4
1853. ce 6, "KENTU/INDIA/ILLIN"
1854. CASE 6
1855. l = 26
1856. m = 27
1857. h = 29
1858. COLOR 14
1859. ce 6, "ATLAN/VENTN/MARVI"
1860. CASE 7
1861. l = 31
1862. m = 32
1863. h = 34
1864. COLOR 10
1865. ce 6, "PACIF/NORTH/PENAV"
1866. CASE 8
1867. l = 37
1868. m = 2
1869. h = 39
1870. COLOR 9
1871. ce 6, "PARKP/BOARD"
1872. END SELECT
1873. COLOR 15
1874. END SUB
1875.  
1876. SUB popp (t, cge)
1877. pay t, cge
1878. st(3 - t).c = st(3 - t).c + cge
1879. ce 13, " to " + RTRIM$(st(3 - t).ft)
1880. p
1881. END SUB
1882.  
1883. SUB quit
1884. DO
1885. LOOP UNTIL INKEY$ = ""
1886. DO
1887. quithue = ((quithue + 1) AND 15) OR 8
1888. COLOR quithue
1889. ce 17, "ARE YOU SURE YOU WANT TO QUIT? (Y/N)"
1890. clk .09
1891. yn$ = LCASE$(INKEY$)
1892. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1893. COLOR 15
1894. IF yn$ = "y" THEN
1895. IF st(1).c < 0 THEN gov 2
1896. IF st(2).c < 0 THEN gov 1
1897. worth1 = cw(1)
1898. worth2 = cw(2)
1899. IF worth1 > worth2 THEN gov 1
1900. IF worth2 > worth1 THEN gov 2
1901. gov 0
1902. END IF
1903. END SUB
1904.  
1905. SUB rlc (t)
1906. IF lot(st(t).whr).own = 0 THEN
1907. noo t
1908. EXIT SUB
1909. END IF
1910. IF lot(st(t).whr).own = t THEN
1911. COLOR lot(st(t).whr).hue
1912. ce 12, RTRIM$(lot(st(t).whr).ttl)
1913. COLOR 15
1914. ce 13, "is yours."
1915. p
1916. EXIT SUB
1917. END IF
1918. IF lot(st(t).whr).hk THEN
1919. COLOR lot(st(t).whr).hue
1920. ce 12, RTRIM$(lot(st(t).whr).ttl)
1921. COLOR 15
1922. ce 13, "is mortgaged."
1923. p
1924. EXIT SUB
1925. END IF
1926. SELECT CASE lot(st(t).whr).stat
1927. CASE 1
1928. popp t, 50
1929. CASE 2
1930. popp t, 100
1931. CASE 3
1932. popp t, 200
1933. CASE 4
1934. popp t, 400
1935. END SELECT
1936. END SUB
1937.  
1938. SUB rules
1939. x = -1
1940. box
1941. ce 5, "I will start a new game."
1942. ce 7, "Do you want the Free Parking jackpot? (Y/N)"
1943. DO
1944. LOOP UNTIL INKEY$ = ""
1945. DO
1946. yn$ = LCASE$(INKEY$)
1947. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1948. ce 8, UCASE$(yn$)
1949. IF yn$ = "y" THEN
1950. j = -1
1951. fr& = 500
1952. END IF
1953. ce 9, "Do you want the land on Go bonus? (Y/N)"
1954. DO
1955. LOOP UNTIL INKEY$ = ""
1956. DO
1957. yn$ = LCASE$(INKEY$)
1958. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1959. ce 10, UCASE$(yn$)
1960. IF yn$ = "y" THEN bn = -1
1961. ce 11, "Do you want unlimited buildings in the bank? (Y/N)"
1962. DO
1963. LOOP UNTIL INKEY$ = ""
1964. DO
1965. yn$ = LCASE$(INKEY$)
1966. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1967. ce 12, UCASE$(yn$)
1968. IF yn$ = "n" THEN x = 0
1969. ce 13, "Do you want to suspend mortgage interest? (Y/N)"
1970. DO
1971. LOOP UNTIL INKEY$ = ""
1972. DO
1973. yn$ = LCASE$(INKEY$)
1974. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1975. ce 14, UCASE$(yn$)
1976. IF yn$ = "y" THEN uf! = .5 ELSE uf! = .55
1977. ce 15, "Should builings sell back at full price? (Y/N)"
1978. DO
1979. LOOP UNTIL INKEY$ = ""
1980. DO
1981. yn$ = LCASE$(INKEY$)
1982. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1983. ce 16, UCASE$(yn$)
1984. IF yn$ = "y" THEN sf! = 1 ELSE sf! = .5
1985. ce 17, "Do you want quiet mode? (Y/N)"
1986. DO
1987. LOOP UNTIL INKEY$ = ""
1988. DO
1989. yn$ = LCASE$(INKEY$)
1990. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1991. ce 18, UCASE$(yn$)
1992. IF yn$ = "y" THEN q = -1
1993. p
1994. END SUB
1995.  
1996. SUB save (t)
1997. ce 10, "to be continued."
1998. OPEN "monopoly.dat" FOR OUTPUT AS #1
1999. PRINT #1, sf!
2000. PRINT #1, uf!
2001. PRINT #1, t
2002. PRINT #1, fr&
2003. PRINT #1, bhu
2004. PRINT #1, bht
2005. PRINT #1, j
2006. PRINT #1, bn
2007. PRINT #1, x
2008. PRINT #1, q
2009. FOR sq = 0 TO 39
2010. PRINT #1, lot(sq).own
2011. PRINT #1, lot(sq).stat
2012. PRINT #1, lot(sq).mop
2013. PRINT #1, lot(sq).hk
2014. NEXT
2015. FOR sq = 1 TO 2
2016. PRINT #1, st(sq).ft
2017. PRINT #1, st(sq).tk
2018. PRINT #1, st(sq).c
2019. PRINT #1, st(sq).whr
2020. PRINT #1, st(sq).jc
2021. PRINT #1, st(sq).dc
2022. PRINT #1, st(sq).chag
2023. PRINT #1, st(sq).cheg
2024. NEXT
2025. FOR sq = 1 TO 16
2026. PRINT #1, cha(sq)
2027. PRINT #1, che(sq)
2028. NEXT
2029. CLOSE
2030. crd
2031. END SUB
2032.  
2033. SUB scha
2034. box
2035. ce 5, "Shuffling Chance cards."
2036. ce 6, "Please wait."
2037. clk 2
2038. IF cha(8) = 2 THEN goojfflag = -1
2039. FOR flip = 1 TO 16
2040. cha(flip) = 0
2041. NEXT
2042. IF goojfflag THEN cha(8) = 2
2043. END SUB
2044.  
2045. SUB sche
2046. box
2047. ce 5, "Shuffling Community Chest cards."
2048. ce 6, "Please wait."
2049. clk 2
2050. IF che(6) = 2 THEN goojfflag = -1
2051. FOR flip = 1 TO 16
2052. che(flip) = 0
2053. NEXT
2054. IF goojfflag THEN che(6) = 2
2055. END SUB
2056.  
2057. SUB short (t, l, m, h)
2058. IF lot(h).stat = 5 THEN
2059. lot(h).stat = 4
2060. bht = bht + 1
2061. st(t).c = st(t).c + lot(l).bc * sf!
2062. END IF
2063. IF lot(m).stat = 5 THEN
2064. lot(m).stat = 4
2065. bht = bht + 1
2066. st(t).c = st(t).c + lot(l).bc * sf!
2067. END IF
2068. IF lot(l).stat = 5 THEN
2069. lot(l).stat = 4
2070. bht = bht + 1
2071. st(t).c = st(t).c + lot(l).bc * sf!
2072. END IF
2073. quan = chou(1) + chou(2) - 32
2074. tot = lot(l).stat + lot(m).stat + lot(h).stat - quan
2075. SELECT CASE m
2076. CASE 2
2077. lot(h).stat = INT(tot / 2)
2078. lot(l).stat = INT(tot / 2)
2079. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
2080. CASE ELSE
2081. lot(h).stat = INT(tot / 3)
2082. lot(m).stat = INT(tot / 3)
2083. lot(l).stat = INT(tot / 3)
2084. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
2085. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
2086. END SELECT
2087. st(t).c = st(t).c + lot(l).bc * quan * sf!
2088. bhu = 0
2089. box
2090. ce 5, RTRIM$(st(t).ft)
2091. ce 7, "a housing shortage sale taken place."
2092. p
2093. END SUB
2094.  
2095. SUB shot (t)
2096. DIM gm(9)
2097. gm(0) = -1
2098. box
2099. IF lot(3).own = t AND lot(3).stat = 5 THEN
2100. gm(1) = -1
2101. mini 1
2102. END IF
2103. IF lot(9).own = t AND lot(9).stat = 5 THEN
2104. gm(2) = -1
2105. mini 2
2106. END IF
2107. IF lot(14).own = t AND lot(14).stat = 5 THEN
2108. gm(3) = -1
2109. mini 3
2110. END IF
2111. IF lot(19).own = t AND lot(19).stat = 5 THEN
2112. gm(4) = -1
2113. mini 4
2114. END IF
2115. IF lot(24).own = t AND lot(24).stat = 5 THEN
2116. gm(5) = -1
2117. mini 5
2118. END IF
2119. IF lot(29).own = t AND lot(29).stat = 5 THEN
2120. gm(6) = -1
2121. mini 6
2122. END IF
2123. IF lot(34).own = t AND lot(34).stat = 5 THEN
2124. gm(7) = -1
2125. mini 7
2126. END IF
2127. IF lot(39).own = t AND lot(39).stat = 5 THEN
2128. gm(8) = -1
2129. mini 8
2130. END IF
2131. ce 9, RTRIM$(st(t).ft)
2132. ce 10, "Choose a monopoly to sell hotels from"
2133. ce 11, "or 0 to continue"
2134. DO
2135. IF ws > 0 AND (NOT q) THEN b
2136. DO
2137. LOOP UNTIL INKEY$ = ""
2138. DO
2139. ws$ = INKEY$
2140. IF ws$ = CHR$(13) THEN ws$ = "0"
2141. LOOP UNTIL ws$ > ""
2142. IF ws$ >= "0" AND ws$ <= "8" THEN ws = VAL(ws$) ELSE ws = 9
2143. LOOP UNTIL gm(ws)
2144. IF ws = 0 THEN EXIT SUB
2145. box
2146. ce 5, RTRIM$(st(t).ft)
2147. pim ws, l, m, h
2148. SELECT CASE m
2149. CASE 2
2150. IF lot(l).stat = 5 THEN max = 2 ELSE max = 1
2151. CASE ELSE
2152. max = 1
2153. IF lot(m).stat = 5 THEN max = 2
2154. IF lot(l).stat = 5 THEN max = 3
2155. END SELECT
2156. ce 7, "you can sell up to " + lts(max) + " hotel(s)."
2157. ce 8, "or 0 to continue"
2158. IF st(t).c >= 0 THEN ce 11, "you have $" + ltsb(st(t).c) ELSE ce 11, "you need to raise $" + lts(-st(t).c)
2159. ce 12, "hotels sell for $" + lts(lot(l).bc * sf!) + " (minus four houses) each."
2160. quan = ner(9, max)
2161. IF quan = 0 THEN EXIT SUB
2162. tot = lot(l).stat + lot(m).stat + lot(h).stat - quan
2163. SELECT CASE m
2164. CASE 2
2165. lot(h).stat = INT(tot / 2)
2166. lot(l).stat = INT(tot / 2)
2167. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
2168. CASE ELSE
2169. lot(h).stat = INT(tot / 3)
2170. lot(m).stat = INT(tot / 3)
2171. lot(l).stat = INT(tot / 3)
2172. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
2173. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
2174. END SELECT
2175. st(t).c = st(t).c + lot(l).bc * quan * sf!
2176. IF (NOT x) THEN
2177. bht = bht + quan
2178. bhu = bhu - 4 * quan
2179. IF bhu < 0 THEN short t, l, m, h
2180. END IF
2181. END SUB
2182.  
2183. SUB shou (t)
2184. DIM gm(9)
2185. gm(0) = -1
2186. box
2187. IF lot(3).own = t AND lot(3).stat > 0 AND lot(3).stat < 5 THEN
2188. gm(1) = -1
2189. mini 1
2190. END IF
2191. IF lot(9).own = t AND lot(9).stat > 0 AND lot(9).stat < 5 THEN
2192. gm(2) = -1
2193. mini 2
2194. END IF
2195. IF lot(14).own = t AND lot(14).stat > 0 AND lot(14).stat < 5 THEN
2196. gm(3) = -1
2197. mini 3
2198. END IF
2199. IF lot(19).own = t AND lot(19).stat > 0 AND lot(19).stat < 5 THEN
2200. gm(4) = -1
2201. mini 4
2202. END IF
2203. IF lot(24).own = t AND lot(24).stat > 0 AND lot(24).stat < 5 THEN
2204. gm(5) = -1
2205. mini 5
2206. END IF
2207. IF lot(29).own = t AND lot(29).stat > 0 AND lot(29).stat < 5 THEN
2208. gm(6) = -1
2209. mini 6
2210. END IF
2211. IF lot(34).own = t AND lot(34).stat > 0 AND lot(34).stat < 5 THEN
2212. gm(7) = -1
2213. mini 7
2214. END IF
2215. IF lot(39).own = t AND lot(39).stat > 0 AND lot(39).stat < 5 THEN
2216. gm(8) = -1
2217. mini 8
2218. END IF
2219. ce 9, RTRIM$(st(t).ft)
2220. ce 10, "Choose a monopoly to sell houses from"
2221. ce 11, "or 0 to continue"
2222. DO
2223. IF ws > 0 AND (NOT q) THEN b
2224. DO
2225. LOOP UNTIL INKEY$ = ""
2226. DO
2227. ws$ = INKEY$
2228. IF ws$ = CHR$(13) THEN ws$ = "0"
2229. LOOP UNTIL ws$ > ""
2230. IF ws$ >= "0" AND ws$ <= "8" THEN ws = VAL(ws$) ELSE ws = 9
2231. LOOP UNTIL gm(ws)
2232. IF ws = 0 THEN EXIT SUB
2233. box
2234. ce 5, RTRIM$(st(t).ft)
2235. pim ws, l, m, h
2236. SELECT CASE m
2237. CASE 2
2238. max = lot(l).stat + lot(h).stat
2239. CASE ELSE
2240. max = lot(l).stat + lot(m).stat + lot(h).stat
2241. END SELECT
2242. ce 7, "you can sell up to " + lts(max) + " house(s)."
2243. ce 8, "or 0 to continue"
2244. IF st(t).c >= 0 THEN ce 11, "you have $" + ltsb(st(t).c) ELSE ce 11, "you need to raise $" + lts(-st(t).c)
2245. ce 12, "houses sell for $" + lts(lot(l).bc * sf!) + " each."
2246. quan = ner(9, max)
2247. IF quan = 0 THEN EXIT SUB
2248. tot = lot(l).stat + lot(m).stat + lot(h).stat - quan
2249. SELECT CASE m
2250. CASE 2
2251. lot(h).stat = INT(tot / 2)
2252. lot(l).stat = INT(tot / 2)
2253. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
2254. CASE ELSE
2255. lot(h).stat = INT(tot / 3)
2256. lot(m).stat = INT(tot / 3)
2257. lot(l).stat = INT(tot / 3)
2258. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
2259. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
2260. END SELECT
2261. st(t).c = st(t).c + lot(l).bc * quan * sf!
2262. IF (NOT x) THEN bhu = bhu + quan
2263. END SUB
2264.  
2265. SUB sml (wt)
2266. PRINT wt;
2267. lil wt
2268. END SUB
2269.  
2270. SUB swbd
2271. box
2272. COLOR 5
2273. LOCATE 22, 66
2274. PRINT "MEDIT"
2275. LOCATE 22, 52
2276. PRINT "BALTI"
2277. COLOR 11
2278. LOCATE 22, 31
2279. PRINT "ORIEN"
2280. LOCATE 22, 17
2281. PRINT "VERMO"
2282. LOCATE 22, 10
2283. PRINT "CONNE"
2284. COLOR 13
2285. LOCATE 20, 3
2286. PRINT "STCHA"
2287. LOCATE 16, 3
2288. PRINT "STATE"
2289. LOCATE 14, 3
2290. PRINT "VIRGI"
2291. COLOR 12
2292. LOCATE 10, 3
2293. PRINT "STJAM"
2294. LOCATE 6, 3
2295. PRINT "TENNE"
2296. LOCATE 4, 3
2297. PRINT "NEWYO"
2298. COLOR 4
2299. LOCATE 2, 10
2300. PRINT "KENTU"
2301. LOCATE 2, 24
2302. PRINT "INDIA"
2303. LOCATE 2, 31
2304. PRINT "ILLIN"
2305. COLOR 14
2306. LOCATE 2, 45
2307. PRINT "ATLAN"
2308. LOCATE 2, 52
2309. PRINT "VENTN"
2310. LOCATE 2, 66
2311. PRINT "MARVI"
2312. COLOR 10
2313. LOCATE 4, 73
2314. PRINT "PACIF"
2315. LOCATE 6, 73
2316. PRINT "NORTH"
2317. LOCATE 10, 73
2318. PRINT "PENAV"
2319. COLOR 9
2320. LOCATE 16, 73
2321. PRINT "PARKP"
2322. LOCATE 20, 73
2323. PRINT "BOARD"
2324. COLOR 7
2325. LOCATE 22, 38
2326. PRINT "READR"
2327. LOCATE 18, 3
2328. PRINT "ELECT"
2329. LOCATE 12, 3
2330. PRINT "PENRR"
2331. LOCATE 2, 38
2332. PRINT "B&ORR"
2333. LOCATE 2, 59
2334. PRINT "WATER"
2335. LOCATE 12, 73
2336. PRINT "SHORT"
2337. COLOR 15
2338. LOCATE 22, 73
2339. PRINT "<-GO<"
2340. LOCATE 22, 59
2341. PRINT "COMMU"
2342. LOCATE 22, 45
2343. PRINT "INCTX"
2344. LOCATE 22, 24
2345. PRINT "CHANC"
2346. LOCATE 22, 3
2347. PRINT "JUSTV"
2348. LOCATE 8, 3
2349. PRINT "COMMU"
2350. LOCATE 2, 3
2351. PRINT "FREEP"
2352. LOCATE 2, 17
2353. PRINT "CHANC"
2354. LOCATE 2, 73
2355. PRINT "GOTOJ"
2356. LOCATE 8, 73
2357. PRINT "COMMU"
2358. LOCATE 14, 73
2359. PRINT "CHANC"
2360. LOCATE 18, 73
2361. PRINT "LUXTX"
2362. END SUB
2363.  
2364. SUB swbs
2365. FOR sq = 1 TO 39
2366. IF lot(sq).sty = "b" THEN
2367. LOCATE lot(sq).bdn, lot(sq).bac
2368. IF (NOT lot(sq).mop) THEN
2369. PRINT " "
2370. ELSE
2371. SELECT CASE lot(sq).stat
2372. CASE 0 TO 4
2373. COLOR 0, 10
2374. PRINT USING "#"; lot(sq).stat
2375. CASE 5
2376. COLOR 0, 4
2377. PRINT "H"
2378. END SELECT
2379. COLOR 15, 0
2380. END IF
2381. END IF
2382. NEXT
2383. END SUB
2384.  
2385. SUB tiny (wt)
2386. PRINT wt;
2387. COLOR lot(wt).hue
2388. PRINT lot(wt).ab
2389. COLOR 15
2390. END SUB
2391.  
2392. SUB tj (t)
2393. st(t).jc = st(t).jc + 1
2394. box
2395. ce 5, RTRIM$(st(t).ft) + ", in Jail, turn " + lts(st(t).jc) + " with $" + ltsb(st(t).c)
2396. IF cr(t) + st(t).c >= 50 THEN ce 6, "press M to Make bail (pay $50)"
2397. IF st(t).chag OR st(t).cheg THEN ce 7, "press C to use 'get out of jail free' Card"
2398. ce 8, "press R to Roll dice"
2399. DO
2400. LOOP UNTIL INKEY$ = ""
2401. DO
2402. how$ = LCASE$(INKEY$)
2403. LOOP UNTIL how$ = "r" OR (how$ = "m" AND cr(t) + st(t).c >= 50) OR (how$ = "c" AND (st(t).chag OR st(t).cheg))
2404. box
2405. SELECT CASE how$
2406. CASE "r"
2407. ce 5, RTRIM$(st(t).ft) + ", roll " + lts(st(t).jc) + " done, with $" + ltsb(st(t).c)
2408. rlout = di(d1, d2)
2409. ce 10, lts(d1) + " + " + lts(d2) + " = " + lts(rlout)
2410. p
2411. IF d1 = d2 THEN
2412. st(t).jc = 0
2413. st(t).whr = 10
2414. box
2415. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2416. PRINT st(t).tk
2417. move rlout, t
2418. act rlout, t
2419. END IF
2420. IF st(t).jc = 3 THEN
2421. IF st(t).chag OR st(t).cheg THEN
2422. ce 6, "press M to Make bail (pay $50)"
2423. ce 7, "press C to use 'get out of jail free' Card"
2424. END IF
2425. DO
2426. LOOP UNTIL INKEY$ = ""
2427. DO
2428. payout$ = LCASE$(INKEY$)
2429. IF (NOT st(t).chag) AND (NOT st(t).cheg) THEN payout$ = "m"
2430. LOOP UNTIL payout$ = "m" OR payout$ = "c"
2431. SELECT CASE payout$
2432. CASE "m"
2433. pay t, 50
2434. IF j THEN fr& = fr& + 50
2435. CASE "c"
2436. IF st(t).chag AND st(t).cheg THEN
2437. ce 10, "Pick a card."
2438. ce 11, "Press A for chAnce"
2439. ce 12, "press O for cOmmunity che"
2440. END IF
2441. DO
2442. LOOP UNTIL INKEY$ = ""
2443. DO
2444. wtc$ = LCASE$(INKEY$)
2445. IF (NOT st(t).chag) THEN wtc$ = "o"
2446. IF (NOT st(t).cheg) THEN wtc$ = "a"
2447. LOOP UNTIL wtc$ = "a" OR wtc$ = "o"
2448. IF wtc$ = "a" THEN
2449. ce 13, "Chance card used."
2450. st(t).chag = 0
2451. cha(8) = 1
2452. ELSE
2453. ce 13, "Community Chest card used."
2454. st(t).cheg = 0
2455. che(6) = 1
2456. END IF
2457. END SELECT
2458. p
2459. st(t).jc = 0
2460. st(t).whr = 10
2461. box
2462. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2463. PRINT st(t).tk
2464. move rlout, t
2465. act rlout, t
2466. END IF
2467. opt t
2468. CASE "m"
2469. pay t, 50
2470. IF j THEN fr& = fr& + 50
2471. st(t).jc = 0
2472. p
2473. box
2474. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2475. PRINT st(t).tk
2476. st(t).whr = 10
2477. tn t
2478. CASE "c"
2479. IF st(t).chag AND st(t).cheg THEN
2480. ce 10, "Pick a card."
2481. ce 11, "Press A for chAnce"
2482. ce 12, "press O for cOmmunity che"
2483. END IF
2484. DO
2485. LOOP UNTIL INKEY$ = ""
2486. DO
2487. wtc$ = LCASE$(INKEY$)
2488. IF (NOT st(t).chag) THEN wtc$ = "o"
2489. IF (NOT st(t).cheg) THEN wtc$ = "a"
2490. LOOP UNTIL wtc$ = "a" OR wtc$ = "o"
2491. IF wtc$ = "a" THEN
2492. ce 13, "Chance card used."
2493. st(t).chag = 0
2494. cha(8) = 1
2495. ELSE
2496. ce 13, "Community Chest card used."
2497. st(t).cheg = 0
2498. che(6) = 1
2499. END IF
2500. p
2501. box
2502. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2503. PRINT st(t).tk
2504. st(t).jc = 0
2505. st(t).whr = 10
2506. tn t
2507. END SELECT
2508. END SUB
2509.  
2510. SUB tn (t)
2511. DO
2512. box
2513. ce 5, RTRIM$(st(t).ft) + " press any key to roll the dice."
2514. p
2515. box
2516. ce 5, RTRIM$(st(t).ft)
2517. rl = di(d1, d2)
2518. ce 7, lts(d1) + " + " + lts(d2) + " = " + lts(rl)
2519. IF d1 = d2 THEN st(t).dc = st(t).dc + 1 ELSE st(t).dc = 0
2520. SELECT CASE st(t).dc
2521. CASE 0
2522. clk 1.5
2523. CASE 1
2524. ce 8, "first doubles"
2525. clk 1.5
2526. CASE 2
2527. ce 8, "second doubles"
2528. clk 1.5
2529. CASE 3
2530. ce 8, "Third doubles"
2531. ar t
2532. END SELECT
2533. IF st(t).whr > -10 THEN
2534. move rl, t
2535. act rl, t
2536. END IF
2537. opt t
2538. LOOP UNTIL st(t).dc = 0
2539. END SUB
2540.  
2541. SUB trade
2542. DIM wit(41), cg(1 TO 2)
2543. FOR gvr = 1 TO 2
2544. DO
2545. REDIM mt(41)
2546. mt(0) = -1
2547. box
2548. IF lot(1).own = gvr AND lot(3).stat = 0 THEN
2549. LOCATE 5, 11
2550. sml 1
2551. mt(1) = -1
2552. END IF
2553. IF lot(3).own = gvr AND lot(3).stat = 0 THEN
2554. LOCATE 6, 11
2555. sml 3
2556. mt(3) = -1
2557. END IF
2558. IF lot(5).own = gvr THEN
2559. LOCATE 7, 11
2560. sml 5
2561. mt(5) = -1
2562. END IF
2563. IF lot(6).own = gvr AND lot(9).stat = 0 THEN
2564. LOCATE 8, 11
2565. sml 6
2566. mt(6) = -1
2567. END IF
2568. IF lot(8).own = gvr AND lot(9).stat = 0 THEN
2569. LOCATE 9, 11
2570. sml 8
2571. mt(8) = -1
2572. END IF
2573. IF lot(9).own = gvr AND lot(9).stat = 0 THEN
2574. LOCATE 10, 11
2575. sml 9
2576. mt(9) = -1
2577. END IF
2578. IF lot(11).own = gvr AND lot(14).stat = 0 THEN
2579. LOCATE 5, 25
2580. sml 11
2581. mt(11) = -1
2582. END IF
2583. IF lot(12).own = gvr THEN
2584. LOCATE 6, 25
2585. sml 12
2586. mt(12) = -1
2587. END IF
2588. IF lot(13).own = gvr AND lot(14).stat = 0 THEN
2589. LOCATE 7, 25
2590. sml 13
2591. mt(13) = -1
2592. END IF
2593. IF lot(14).own = gvr AND lot(14).stat = 0 THEN
2594. LOCATE 8, 25
2595. sml 14
2596. mt(14) = -1
2597. END IF
2598. IF lot(15).own = gvr THEN
2599. LOCATE 9, 25
2600. sml 15
2601. mt(15) = -1
2602. END IF
2603. IF lot(16).own = gvr AND lot(19).stat = 0 THEN
2604. LOCATE 10, 25
2605. sml 16
2606. mt(16) = -1
2607. END IF
2608. IF lot(18).own = gvr AND lot(19).stat = 0 THEN
2609. LOCATE 11, 25
2610. sml 18
2611. mt(18) = -1
2612. END IF
2613. IF lot(19).own = gvr AND lot(19).stat = 0 THEN
2614. LOCATE 12, 25
2615. sml 19
2616. mt(19) = -1
2617. END IF
2618. IF lot(21).own = gvr AND lot(24).stat = 0 THEN
2619. LOCATE 5, 40
2620. sml 21
2621. mt(21) = -1
2622. END IF
2623. IF lot(23).own = gvr AND lot(24).stat = 0 THEN
2624. LOCATE 6, 40
2625. sml 23
2626. mt(23) = -1
2627. END IF
2628. IF lot(24).own = gvr AND lot(24).stat = 0 THEN
2629. LOCATE 7, 40
2630. sml 24
2631. mt(24) = -1
2632. END IF
2633. IF lot(25).own = gvr THEN
2634. LOCATE 8, 40
2635. sml 25
2636. mt(25) = -1
2637. END IF
2638. IF lot(26).own = gvr AND lot(29).stat = 0 THEN
2639. LOCATE 9, 40
2640. sml 26
2641. mt(26) = -1
2642. END IF
2643. IF lot(27).own = gvr AND lot(29).stat = 0 THEN
2644. LOCATE 10, 40
2645. sml 27
2646. mt(27) = -1
2647. END IF
2648. IF lot(28).own = gvr THEN
2649. LOCATE 11, 40
2650. sml 28
2651. mt(28) = -1
2652. END IF
2653. IF lot(29).own = gvr AND lot(29).stat = 0 THEN
2654. LOCATE 12, 40
2655. sml 29
2656. mt(29) = -1
2657. END IF
2658. IF lot(31).own = gvr AND lot(34).stat = 0 THEN
2659. LOCATE 5, 55
2660. sml 31
2661. mt(31) = -1
2662. END IF
2663. IF lot(32).own = gvr AND lot(34).stat = 0 THEN
2664. LOCATE 6, 55
2665. sml 32
2666. mt(32) = -1
2667. END IF
2668. IF lot(34).own = gvr AND lot(34).stat = 0 THEN
2669. LOCATE 7, 55
2670. sml 34
2671. mt(34) = -1
2672. END IF
2673. IF lot(35).own = gvr THEN
2674. LOCATE 8, 55
2675. sml 35
2676. mt(35) = -1
2677. END IF
2678. IF lot(37).own = gvr AND lot(39).stat = 0 THEN
2679. LOCATE 9, 55
2680. sml 37
2681. mt(37) = -1
2682. END IF
2683. IF lot(39).own = gvr AND lot(39).stat = 0 THEN
2684. LOCATE 10, 55
2685. sml 39
2686. mt(39) = -1
2687. END IF
2688. IF st(gvr).chag THEN
2689. LOCATE 12, 11
2690. PRINT 40;
2691. COLOR 12
2692. PRINT "GOOJF"
2693. COLOR 15
2694. mt(40) = -1
2695. END IF
2696. IF st(gvr).cheg THEN
2697. LOCATE 12, 55
2698. PRINT 41;
2699. COLOR 14
2700. PRINT "GOOJF"
2701. COLOR 15
2702. mt(41) = -1
2703. END IF
2704. ce 13, RTRIM$(st(gvr).ft) + ", you have $" + ltsb(st(gvr).c)
2705. ce 14, "Choose a deed to trade or 0 to continue"
2706. DO
2707. pick = 0
2708. IF (NOT mt(pick)) AND (NOT q) THEN b
2709. pick = ner(15, 41)
2710. LOOP UNTIL mt(pick)
2711. SELECT CASE pick
2712. CASE 1 TO 39
2713. lot(pick).own = 0
2714. CASE 40
2715. st(gvr).chag = 0
2716. CASE 41
2717. st(gvr).cheg = 0
2718. END SELECT
2719. wit(pick) = gvr
2720. LOOP UNTIL pick = 0
2721. ce 16, "cash to give"
2722. cg(gvr) = nerb(17, st(gvr).c)
2723. NEXT
2724. IF cg(1) > cg(2) THEN
2725. box
2726. popp 1, cg(1) - cg(2)
2727. END IF
2728. IF cg(2) > cg(1) THEN
2729. box
2730. popp 2, cg(2) - cg(1)
2731. END IF
2732. IF wit(40) > 0 THEN st(3 - wit(40)).chag = -1
2733. IF wit(41) > 0 THEN st(3 - wit(41)).cheg = -1
2734. FOR flip = 1 TO 39
2735. IF wit(flip) > 0 AND (NOT lot(flip).hk) THEN
2736. lot(flip).own = 3 - wit(flip)
2737. wit(flip) = 0
2738. END IF
2739. NEXT
2740. FOR flip = 1 TO 39
2741. IF wit(flip) > 0 THEN
2742. lot(flip).own = 3 - wit(flip)
2743. box
2744. ce 5, RTRIM$(st(3 - wit(flip)).ft) + ", you have $" + ltsb(st(3 - wit(flip)).c)
2745. COLOR lot(flip).hue
2746. ce 6, RTRIM$(lot(flip).ttl)
2747. COLOR 15
2748. ce 7, "is mortgaged."
2749. IF st(3 - wit(flip)).c >= INT(.5 + lot(flip).c * uf!) THEN
2750. ce 8, "Do you want to unmortgage it now? (Y/N)"
2751. y = INT(.5 + lot(flip).c * uf!)
2752. n = INT(.5 + lot(flip).c * (uf! - .5))
2753. ce 9, "Y will cost $" + lts(y)
2754. IF n > 0 THEN ce 10, "N will cost $" + lts(n)
2755. DO
2756. LOOP UNTIL INKEY$ = ""
2757. DO
2758. yn$ = LCASE$(INKEY$)
2759. LOOP UNTIL yn$ = "y" OR yn$ = "n"
2760. ELSE
2761. yn$ = "n"
2762. END IF
2763. IF yn$ = "y" THEN
2764. pay 3 - wit(flip), y
2765. lot(flip).hk = 0
2766. ELSE
2767. IF n > 0 THEN
2768. pay 3 - wit(flip), n
2769. ce 14, "mortgaged property fee."
2770. END IF
2771. p
2772. END IF
2773. END IF
2774. NEXT
2775. END SUB
2776.  
2777. FUNCTION txk$
2778. DO
2779. DO
2780. LOOP UNTIL INKEY$ = ""
2781. DO
2782. tx$ = INKEY$
2783. LOOP UNTIL tx$ > ""
2784. SELECT CASE LCASE$(tx$)
2785. CASE "a" TO "z", CHR$(13), CHR$(8)
2786. valid = -1
2787. CASE ELSE
2788. valid = 0
2789. IF (NOT q) THEN b
2790. END SELECT
2791. LOOP UNTIL valid
2792. txk = tx$
2793. END FUNCTION
2794.  
2795. SUB unm (t)
2796. DIM gp(39)
2797. gp(0) = -1
2798. box
2799. IF lot(1).own = t AND lot(1).hk AND st(t).c >= INT(.5 + lot(1).c * uf!) THEN
2800. LOCATE 5, 11
2801. dy 1
2802. gp(1) = -1
2803. END IF
2804. IF lot(3).own = t AND lot(3).hk AND st(t).c >= INT(.5 + lot(3).c * uf!) THEN
2805. LOCATE 6, 11
2806. dy 3
2807. gp(3) = -1
2808. END IF
2809. IF lot(5).own = t AND lot(5).hk AND st(t).c >= INT(.5 + lot(5).c * uf!) THEN
2810. LOCATE 7, 11
2811. dy 5
2812. gp(5) = -1
2813. END IF
2814. IF lot(6).own = t AND lot(6).hk AND st(t).c >= INT(.5 + lot(6).c * uf!) THEN
2815. LOCATE 8, 11
2816. dy 6
2817. gp(6) = -1
2818. END IF
2819. IF lot(8).own = t AND lot(8).hk AND st(t).c >= INT(.5 + lot(8).c * uf!) THEN
2820. LOCATE 9, 11
2821. dy 8
2822. gp(8) = -1
2823. END IF
2824. IF lot(9).own = t AND lot(9).hk AND st(t).c >= INT(.5 + lot(9).c * uf!) THEN
2825. LOCATE 10, 11
2826. dy 9
2827. gp(9) = -1
2828. END IF
2829. IF lot(11).own = t AND lot(11).hk AND st(t).c >= INT(.5 + lot(11).c * uf!) THEN
2830. LOCATE 5, 26
2831. dy 11
2832. gp(11) = -1
2833. END IF
2834. IF lot(12).own = t AND lot(12).hk AND st(t).c >= INT(.5 + lot(12).c * uf!) THEN
2835. LOCATE 6, 26
2836. dy 12
2837. gp(12) = -1
2838. END IF
2839. IF lot(13).own = t AND lot(13).hk AND st(t).c >= INT(.5 + lot(13).c * uf!) THEN
2840. LOCATE 7, 26
2841. dy 13
2842. gp(13) = -1
2843. END IF
2844. IF lot(14).own = t AND lot(14).hk AND st(t).c >= INT(.5 + lot(14).c * uf!) THEN
2845. LOCATE 8, 26
2846. dy 14
2847. gp(14) = -1
2848. END IF
2849. IF lot(15).own = t AND lot(15).hk AND st(t).c >= INT(.5 + lot(15).c * uf!) THEN
2850. LOCATE 9, 26
2851. dy 15
2852. gp(15) = -1
2853. END IF
2854. IF lot(16).own = t AND lot(16).hk AND st(t).c >= INT(.5 + lot(16).c * uf!) THEN
2855. LOCATE 10, 26
2856. dy 16
2857. gp(16) = -1
2858. END IF
2859. IF lot(18).own = t AND lot(18).hk AND st(t).c >= INT(.5 + lot(18).c * uf!) THEN
2860. LOCATE 11, 26
2861. dy 18
2862. gp(18) = -1
2863. END IF
2864. IF lot(19).own = t AND lot(19).hk AND st(t).c >= INT(.5 + lot(19).c * uf!) THEN
2865. LOCATE 12, 26
2866. dy 19
2867. gp(19) = -1
2868. END IF
2869. IF lot(21).own = t AND lot(21).hk AND st(t).c >= INT(.5 + lot(21).c * uf!) THEN
2870. LOCATE 5, 41
2871. dy 21
2872. gp(21) = -1
2873. END IF
2874. IF lot(23).own = t AND lot(23).hk AND st(t).c >= INT(.5 + lot(23).c * uf!) THEN
2875. LOCATE 6, 41
2876. dy 23
2877. gp(23) = -1
2878. END IF
2879. IF lot(24).own = t AND lot(24).hk AND st(t).c >= INT(.5 + lot(24).c * uf!) THEN
2880. LOCATE 7, 41
2881. dy 24
2882. gp(24) = -1
2883. END IF
2884. IF lot(25).own = t AND lot(25).hk AND st(t).c >= INT(.5 + lot(25).c * uf!) THEN
2885. LOCATE 8, 41
2886. dy 25
2887. gp(25) = -1
2888. END IF
2889. IF lot(26).own = t AND lot(26).hk AND st(t).c >= INT(.5 + lot(26).c * uf!) THEN
2890. LOCATE 9, 41
2891. dy 26
2892. gp(26) = -1
2893. END IF
2894. IF lot(27).own = t AND lot(27).hk AND st(t).c >= INT(.5 + lot(27).c * uf!) THEN
2895. LOCATE 10, 41
2896. dy 27
2897. gp(27) = -1
2898. END IF
2899. IF lot(28).own = t AND lot(28).hk AND st(t).c >= INT(.5 + lot(28).c * uf!) THEN
2900. LOCATE 11, 41
2901. dy 28
2902. gp(28) = -1
2903. END IF
2904. IF lot(29).own = t AND lot(29).hk AND st(t).c >= INT(.5 + lot(29).c * uf!) THEN
2905. LOCATE 12, 41
2906. dy 29
2907. gp(29) = -1
2908. END IF
2909. IF lot(31).own = t AND lot(31).hk AND st(t).c >= INT(.5 + lot(31).c * uf!) THEN
2910. LOCATE 5, 56
2911. dy 31
2912. gp(31) = -1
2913. END IF
2914. IF lot(32).own = t AND lot(32).hk AND st(t).c >= INT(.5 + lot(32).c * uf!) THEN
2915. LOCATE 6, 56
2916. dy 32
2917. gp(32) = -1
2918. END IF
2919. IF lot(34).own = t AND lot(34).hk AND st(t).c >= INT(.5 + lot(34).c * uf!) THEN
2920. LOCATE 7, 56
2921. dy 34
2922. gp(34) = -1
2923. END IF
2924. IF lot(35).own = t AND lot(35).hk AND st(t).c >= INT(.5 + lot(35).c * uf!) THEN
2925. LOCATE 8, 56
2926. dy 35
2927. gp(35) = -1
2928. END IF
2929. IF lot(37).own = t AND lot(37).hk AND st(t).c >= INT(.5 + lot(37).c * uf!) THEN
2930. LOCATE 9, 56
2931. dy 37
2932. gp(37) = -1
2933. END IF
2934. IF lot(39).own = t AND lot(39).hk AND st(t).c >= INT(.5 + lot(39).c * uf!) THEN
2935. LOCATE 10, 56
2936. dy 39
2937. gp(39) = -1
2938. END IF
2939. ce 13, RTRIM$(st(t).ft)
2940. ce 14, "Choose a deed to unmortgage or 0 to continue"
2941. ce 17, "you have $" + ltsb(st(t).c)
2942. DO
2943. IF (NOT gp(pick)) AND (NOT q) THEN b
2944. pick = ner(15, 39)
2945. LOOP UNTIL gp(pick)
2946. IF pick = 0 THEN EXIT SUB
2947. lot(pick).hk = 0
2948. box
2949. pay t, INT(.5 + lot(pick).c * uf!)
2950. p
2951. END SUB
2952.  
2953. SUB upd
2954. chk 1, 1, 3
2955. chk 6, 8, 9
2956. chk 11, 13, 14
2957. chk 16, 18, 19
2958. chk 21, 23, 24
2959. chk 26, 27, 29
2960. chk 31, 32, 34
2961. chk 37, 37, 39
2962. IF lot(12).own = lot(28).own AND lot(12).own > 0 THEN
2963. lot(12).stat = 2
2964. lot(28).stat = 2
2965. ELSE
2966. lot(12).stat = SGN(lot(12).own)
2967. lot(28).stat = SGN(lot(28).own)
2968. END IF
2969. FOR rtt = 5 TO 35 STEP 10
2970. rro = rro * 10 + lot(rtt).own
2971. lot(rtt).stat = 0
2972. NEXT
2973. SELECT CASE rro
2974. CASE 1111, 2222
2975. lot(5).stat = 4
2976. lot(15).stat = 4
2977. lot(25).stat = 4
2978. lot(35).stat = 4
2979. CASE 111, 222, 1222, 2111
2980. lot(15).stat = 3
2981. lot(25).stat = 3
2982. lot(35).stat = 3
2983. CASE 1011, 1211, 2022, 2122
2984. lot(5).stat = 3
2985. lot(25).stat = 3
2986. lot(35).stat = 3
2987. CASE 1101, 1121, 2202, 2212
2988. lot(5).stat = 3
2989. lot(15).stat = 3
2990. lot(35).stat = 3
2991. CASE 1110, 1112, 2220, 2221
2992. lot(5).stat = 3
2993. lot(15).stat = 3
2994. lot(25).stat = 3
2995. CASE ELSE
2996. IF lot(5).own = lot(15).own AND lot(5).own > 0 THEN
2997. lot(5).stat = 2
2998. lot(15).stat = 2
2999. END IF
3000. IF lot(5).own = lot(25).own AND lot(5).own > 0 THEN
3001. lot(5).stat = 2
3002. lot(25).stat = 2
3003. END IF
3004. IF lot(5).own = lot(35).own AND lot(5).own > 0 THEN
3005. lot(5).stat = 2
3006. lot(35).stat = 2
3007. END IF
3008. IF lot(15).own = lot(25).own AND lot(15).own > 0 THEN
3009. lot(15).stat = 2
3010. lot(25).stat = 2
3011. END IF
3012. IF lot(15).own = lot(35).own AND lot(15).own > 0 THEN
3013. lot(15).stat = 2
3014. lot(35).stat = 2
3015. END IF
3016. IF lot(25).own = lot(35).own AND lot(25).own > 0 THEN
3017. lot(25).stat = 2
3018. lot(35).stat = 2
3019. END IF
3020. END SELECT
3021. FOR rtt = 5 TO 35 STEP 10
3022. IF lot(rtt).stat = 0 THEN lot(rtt).stat = SGN(lot(rtt).own)
3023. NEXT
3024. swbs
3025. END SUB
3026.  
3027. SUB utc (t)
3028. IF lot(st(t).whr).own = 0 THEN
3029. noo t
3030. EXIT SUB
3031. END IF
3032. IF lot(st(t).whr).own = t THEN
3033. COLOR lot(st(t).whr).hue
3034. ce 12, RTRIM$(lot(st(t).whr).ttl)
3035. COLOR 15
3036. ce 13, "is yours."
3037. p
3038. EXIT SUB
3039. END IF
3040. IF lot(st(t).whr).hk THEN
3041. COLOR lot(st(t).whr).hue
3042. ce 12, RTRIM$(lot(st(t).whr).ttl)
3043. COLOR 15
3044. ce 13, "is mortgaged."
3045. p
3046. EXIT SUB
3047. END IF
3048. crl = di(d1, d2)
3049. ce 11, lts(d1) + " + " + lts(d2) + " = " + lts(crl) + ", $" + lts(10 * crl) + " due."
3050. p
3051. popp t, 10 * crl
3052. END SUB
3053.  
3054. SUB vwd
3055. DO
3056. box
3057. LOCATE 5, 11
3058. tiny 1
3059. LOCATE 6, 11
3060. tiny 3
3061. LOCATE 7, 11
3062. tiny 5
3063. LOCATE 8, 11
3064. tiny 6
3065. LOCATE 9, 11
3066. tiny 8
3067. LOCATE 10, 11
3068. tiny 9
3069. LOCATE 5, 25
3070. tiny 11
3071. LOCATE 6, 25
3072. tiny 12
3073. LOCATE 7, 25
3074. tiny 13
3075. LOCATE 8, 25
3076. tiny 14
3077. LOCATE 9, 25
3078. tiny 15
3079. LOCATE 10, 25
3080. tiny 16
3081. LOCATE 11, 25
3082. tiny 18
3083. LOCATE 12, 25
3084. tiny 19
3085. LOCATE 5, 40
3086. tiny 21
3087. LOCATE 6, 40
3088. tiny 23
3089. LOCATE 7, 40
3090. tiny 24
3091. LOCATE 8, 40
3092. tiny 25
3093. LOCATE 9, 40
3094. tiny 26
3095. LOCATE 10, 40
3096. tiny 27
3097. LOCATE 11, 40
3098. tiny 28
3099. LOCATE 12, 40
3100. tiny 29
3101. LOCATE 5, 55
3102. tiny 31
3103. LOCATE 6, 55
3104. tiny 32
3105. LOCATE 7, 55
3106. tiny 34
3107. LOCATE 8, 55
3108. tiny 35
3109. LOCATE 9, 55
3110. tiny 37
3111. LOCATE 10, 55
3112. tiny 39
3113. ce 13, "choose a deed to view or 0 to continue"
3114. wt = ner(14, 39)
3115. IF wt = 0 THEN EXIT DO
3116. SELECT CASE lot(wt).sty
3117. CASE "b"
3118. box
3119. COLOR lot(wt).hue
3120. ce 5, RTRIM$(lot(wt).ttl)
3121. COLOR 7
3122. ce 6, "cost $" + lts(lot(wt).c)
3123. ce 7, "mortgage value $" + lts(lot(wt).c / 2)
3124. ce 8, "rent $" + lts(lot(wt).r)
3125. ce 9, "rent with one house $" + lts(lot(wt).r1)
3126. ce 10, "rent with two houses $" + lts(lot(wt).r2)
3127. ce 11, "rent with three houses $" + lts(lot(wt).r3)
3128. ce 12, "rent with four houses $" + lts(lot(wt).r4)
3129. ce 13, "rent with hotel $" + lts(lot(wt).rhot)
3130. ce 14, "houses cost $" + lts(lot(wt).bc) + " each"
3131. ce 15, "hotel costs $" + lts(lot(wt).bc) + " plus 4 houses"
3132. COLOR 15
3133. IF lot(wt).own = 0 THEN
3134. ce 16, "unowned"
3135. ELSE
3136. ce 16, "owned by " + RTRIM$(st(lot(wt).own).ft)
3137. IF lot(wt).hk THEN
3138. ce 17, "mortgaged, $" + lts(INT(.5 + lot(wt).c * uf!)) + " to unmortgage."
3139. ELSE
3140. SELECT CASE lot(wt).stat
3141. CASE 0
3142. ce 17, "with no buildings"
3143. CASE 1
3144. ce 17, "with one house"
3145. CASE 2
3146. ce 17, "with two houses"
3147. CASE 3
3148. ce 17, "with three houses"
3149. CASE 4
3150. ce 17, "with four houses"
3151. CASE 5
3152. ce 17, "with hotel"
3153. END SELECT
3154. END IF
3155. END IF
3156. p
3157. CASE "u"
3158. box
3159. COLOR lot(wt).hue
3160. ce 5, RTRIM$(lot(wt).ttl)
3161. COLOR 15
3162. ce 6, "cost $150"
3163. ce 7, "mortgage value $75"
3164. ce 8, "rent with one Utility, four times dice"
3165. ce 9, "rent with two Utilities, ten times dice"
3166. IF lot(wt).own = 0 THEN
3167. ce 16, "unowned"
3168. ELSE
3169. ce 16, "owned by " + RTRIM$(st(lot(wt).own).ft)
3170. IF lot(wt).hk THEN ce 17, "mortgaged, $" + lts(INT(.5 + lot(wt).c * uf!)) + " to unmortgage."
3171. SELECT CASE lot(wt).stat
3172. CASE 1
3173. ce 18, "one Utility"
3174. CASE 2
3175. ce 18, "two utlities"
3176. END SELECT
3177. END IF
3178. p
3179. CASE "r"
3180. box
3181. COLOR lot(wt).hue
3182. ce 5, RTRIM$(lot(wt).ttl)
3183. COLOR 15
3184. ce 6, "cost $200"
3185. ce 7, "mortgage value $100"
3186. ce 8, "rent with one Railroad $25"
3187. ce 9, "rent with two Railroads $50"
3188. ce 10, "rent with three Railroads $100"
3189. ce 11, "rent with four Railroads $200"
3190. IF lot(wt).own = 0 THEN
3191. ce 16, "unowned"
3192. ELSE
3193. ce 16, "owned by " + RTRIM$(st(lot(wt).own).ft)
3194. IF lot(wt).hk THEN ce 17, "mortgaged, $" + lts(INT(.5 + lot(wt).c * uf!)) + " to unmortgage."
3195. SELECT CASE lot(wt).stat
3196. CASE 1
3197. ce 18, "one Railroad"
3198. CASE 2
3199. ce 18, "two Railroads"
3200. CASE 3
3201. ce 18, "three Railroads"
3202. CASE 4
3203. ce 18, "four Railroads"
3204. END SELECT
3205. END IF
3206. p
3207. CASE "o"
3208. IF (NOT q) THEN b
3209. END SELECT
3210. LOOP UNTIL wt = 0
3211. END SUB
3212.  
3213.  

I apologise with all QB64 coders not mentioned here, I preferred to use code taken from sample folder of QB64.
Hey I must apologise also with curator of the QB64 website! I have posted a code more than 1000 lines and you can find fun that linecode's number restarts from 1 after 1000!
Thanks to read

[bplus]

Code from here: "CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"

Uses GOTO because they did not have ELSE not to mention SUBs and FUNCTIONs, that code is very tame spaghetti-O's and worth study.

[Kiara87]

Hi
from my point of view
this is an old style of coding a program

Code: QB64: [Select]

1. 10 PRINT TAB(32);"ANIMAL"
2. 20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
3. 30 PRINT: PRINT: PRINT
4. 40 PRINT "PLAY 'GUESS THE ANIMAL'"
5. 45 PRINT
6. 50 PRINT "THINK OF AN ANIMAL AND THE COMPUTER WILL TRY TO GUESS IT."
7. 60 PRINT
8. 70 DIM A$(200)
9. 80 FOR I=0 TO 3
10. 90 READ A$(I)
11. 100 NEXT I
12. 110 N=VAL(A$(0))
13. 120 REM          MAIN CONTROL SECTION
14. 130 INPUT "ARE YOU THINKING OF AN ANIMAL";A$
15. 140 IF A$="LIST" THEN 600
16. 150 IF LEFT$(A$,1)<>"Y" THEN 120
17. 160 K=1
18. 170 GOSUB 390
19. 180 IF LEN(A$(K))=0 THEN 999
20. 190 IF LEFT$(A$(K),2)="\Q" THEN 170
21. 200 PRINT "IS IT A ";RIGHT$(A$(K),LEN(A$(K))-2);
22. 210 INPUT A$
23. 220 A$=LEFT$(A$,1)
24. 230 IF LEFT$(A$,1)="Y" THEN PRINT "WHY NOT TRY ANOTHER ANIMAL?": GOTO 120
25. 240 INPUT "THE ANIMAL YOU WERE THINKING OF WAS A ";V$
26. 250 PRINT "PLEASE TYPE IN A QUESTION THAT WOULD DISTINGUISH A"
27. 260 PRINT V$;" FROM A ";RIGHT$(A$(K),LEN(A$(K))-2)
28. 270 INPUT X$
29. 280 PRINT "FOR A ";V$;" THE ANSWER WOULD BE ";
30. 290 INPUT A$
31. 300 A$=LEFT$(A$,1): IF A$<>"Y" AND A$<>"N" THEN 280
32. 310 IF A$="Y" THEN B$="N"
33. 320 IF A$="N" THEN B$="Y"
34. 330 Z1=VAL(A$(0))
35. 340 A$(0)=STR$(Z1+2)
36. 350 A$(Z1)=A$(K)
37. 360 A$(Z1+1)="\A"+V$
38. 370 A$(K)="\Q"+X$+"\"+A$+STR$(Z1+1)+"\"+B$+STR$(Z1)+"\"
39. 380 GOTO 120
40. 390 REM     SUBROUTINE TO PRINT QUESTIONS
41. 400 Q$=A$(K)
42. 410 FOR Z=3 TO LEN(Q$)
43. 415 IF MID$(Q$,Z,1)<>"\" THEN PRINT MID$(Q$,Z,1);
44. 417 NEXT Z
45. 420 INPUT C$
46. 430 C$=LEFT$(C$,1)
47. 440 IF C$<>"Y" AND C$<>"N" THEN 410
48. 450 T$="\"+C$
49. 455 FOR X=3 TO LEN(Q$)-1
50. 460 IF MID$(Q$,X,2)=T$ THEN 480
51. 470 NEXT X
52. 475 STOP
53. 480 FOR Y=X+1 TO LEN(Q$)
54. 490 IF MID$(Q$,Y,1)="\" THEN 510
55. 500 NEXT Y
56. 505 STOP
57. 510 K=VAL(MID$(Q$,X+2,Y-X-2))
58. 520 RETURN
59. 530 DATA "4","\QDOES IT SWIM\Y2\N3\","\AFISH","\ABIRD"
60. 600 PRINT:PRINT "ANIMALS I ALREADY KNOW ARE:"
61. 605 X=0
62. 610 FOR I=1 TO 200
63. 620 IF LEFT$(A$(I),2)<>"\A" THEN 650
64. 624 PRINT TAB(15*X);
65. 630 FOR Z=3 TO LEN(A$(I))
66. 640 IF MID$(A$(I),Z,1)<>"\" THEN PRINT MID$(A$(I),Z,1);
67. 642 NEXT Z
68. 645 X=X+1: IF X=4 THEN X=0: PRINT
69. 650 NEXT I
70. 660 PRINT
71. 670 PRINT
72. 680 GOTO 120
73. 999 END
74.  

that we can call "spaghetti code"... the program runs ok... but its readableness is very poor, now think how  you work to modify this code to guess a number at the place of an animal...the maintenance is harder than a program with code written using the structured technique

this one also using GOTO has a more readableness

Code: QB64: [Select]

1. 5 CLS
2. PRINT "1) ADD"
3. PRINT "2) MULTIPLY"
4. PRINT "3) DIVIDE"
5. PRINT "4) SQUARE ROOT"
6. PRINT "5) EXIT"
7. INPUT I
8. IF I = 1 GOTO 10
9. IF I = 2 GOTO 20
10. IF I = 3 GOTO 30
11. IF I = 4 GOTO 40
12. IF I = 5 GOTO 50
13. END
14. 10 CLS : PRINT "INPUT NUMBER"
15. INPUT A
16. CLS
17. PRINT "INPUT NEXT NUMBER"
18. INPUT B
19. CLS
20. PRINT A + B
21. PRINT "PRESS SPACE TO RUN"
22. SLEEP 0
23. GOTO 5
24. 20 CLS : PRINT "INPUT NUMBER"
25. INPUT C
26. CLS
27. PRINT "INPUT NEXT NUMBER"
28. INPUT D
29. CLS
30. PRINT C * D
31. PRINT "PRESS SPACE TO RUN"
32. SLEEP 0
33. GOTO 5
34. 30 CLS : PRINT "INPUT NUMBER"
35. INPUT E
36. CLS
37. PRINT "INPUT NEXT NUMBER"
38. INPUT F
39. CLS
40. PRINT E / F
41. PRINT "PRESS SPACE TO RUN"
42. SLEEP 0
43. GOTO 5
44. 40 CLS : PRINT "INPUT NUMBER"
45. INPUT G
46. CLS
47. PRINT SQR(G)
48. PRINT "PRESS SPACE TO RUN"
49. SLEEP 0
50. GOTO 5
51. 50 END
52.  

Today we can avoid this kind of GOTOing, here the same code structured

Code: QB64: [Select]

1. DO
2.     Info
3.     INPUT I
4.     SELECT CASE I
5.         CASE 1
6.             CLS: PRINT "INPUT NUMBER"
7.             INPUT A
8.             CLS
9.             PRINT "INPUT NEXT NUMBER"
10.             INPUT B
11.             CLS
12.             PRINT A + B
13.             PRINT "PRESS SPACE TO RUN"
14.             SLEEP 0
15.  
16.         CASE 2
17.             CLS: PRINT "INPUT NUMBER"
18.             INPUT C
19.             CLS
20.             PRINT "INPUT NEXT NUMBER"
21.             INPUT D
22.             CLS
23.             PRINT C * D
24.             PRINT "PRESS SPACE TO RUN"
25.             SLEEP 0
26.  
27.         CASE 3
28.             CLS: PRINT "INPUT NUMBER"
29.             INPUT E
30.             CLS
31.             PRINT "INPUT NEXT NUMBER"
32.             INPUT F
33.             CLS
34.             PRINT E / F
35.             PRINT "PRESS SPACE TO RUN"
36.             SLEEP 0
37.  
38.         CASE 4
39.             CLS: PRINT "INPUT NUMBER"
40.             INPUT G
41.             CLS
42.             PRINT SQR(G)
43.             PRINT "PRESS SPACE TO RUN"
44.             SLEEP 0
45.  
46.         CASE 5
47.             END
48.     END SELECT
49. LOOP
50.  
51.  
52.  
53. SUB Info
54.     CLS
55.     PRINT "1) ADD"
56.     PRINT "2) MULTIPLY"
57.     PRINT "3) DIVIDE"
58.     PRINT "4) SQUARE ROOT"
59.     PRINT "5) EXIT"
60. END SUB

Here for the coder is easier to modify the instruction if he must add a new function to the calculator for example Substraction! :-)
but using the structured technique you can reach more complex code without loose its readableness
this is an example

Code: QB64: [Select]

1. DEFINT A-Z
2. DECLARE FUNCTION ak$ ()
3. DECLARE FUNCTION chot (t)
4. DECLARE FUNCTION chou (t)
5. DECLARE FUNCTION cr (t)
6. DECLARE FUNCTION cw (t)
7. DECLARE FUNCTION di (d1, d2)
8. DECLARE FUNCTION lts$ (nu)
9. DECLARE FUNCTION ltsb$ (nu&)
10. DECLARE FUNCTION ner (dn, max)
11. DECLARE FUNCTION nerb& (dn, max&)
12. DECLARE FUNCTION nerk$ ()
13. DECLARE FUNCTION txk$ ()
14. DECLARE SUB act (rl, t)
15. DECLARE SUB ar (t)
16. DECLARE SUB auc (t)
17. DECLARE SUB b ()
18. DECLARE SUB bca (t, houf, hotf)
19. DECLARE SUB box ()
20. DECLARE SUB broke (t)
21. DECLARE SUB buhot (t)
22. DECLARE SUB buhou (t)
23. DECLARE SUB ce (dn, tx$)
24. DECLARE SUB chk (l, m, h)
25. DECLARE SUB clk (se!)
26. DECLARE SUB cont (t, nos)
27. DECLARE SUB crd ()
28. DECLARE SUB dcha (t)
29. DECLARE SUB dche (t)
30. DECLARE SUB dy (wt)
31. DECLARE SUB fd (rl1, rl2, d1, d2, d3, d4)
32. DECLARE SUB gov (t)
33. DECLARE SUB inc (t)
34. DECLARE SUB init ()
35. DECLARE SUB inv ()
36. DECLARE SUB lil (wt)
37. DECLARE SUB lop (rl, t)
38. DECLARE SUB mb ()
39. DECLARE SUB md ()
40. DECLARE SUB mini (gr)
41. DECLARE SUB mob (t)
42. DECLARE SUB more (t)
43. DECLARE SUB mort (t)
44. DECLARE SUB move (dist, t)
45. DECLARE SUB noo (t)
46. DECLARE SUB opt (t)
47. DECLARE SUB p ()
48. DECLARE SUB pay (t, cge)
49. DECLARE SUB pim (gr, l, m, h)
50. DECLARE SUB popp (t, cge)
51. DECLARE SUB quit ()
52. DECLARE SUB rlc (t)
53. DECLARE SUB rules ()
54. DECLARE SUB save (t)
55. DECLARE SUB scha ()
56. DECLARE SUB sche ()
57. DECLARE SUB short (t, l, m, h)
58. DECLARE SUB shot (t)
59. DECLARE SUB shou (t)
60. DECLARE SUB sml (wt)
61. DECLARE SUB swbd ()
62. DECLARE SUB swbs ()
63. DECLARE SUB tiny (wt)
64. DECLARE SUB tj (t)
65. DECLARE SUB tn (t)
66. DECLARE SUB trade ()
67. DECLARE SUB unm (t)
68. DECLARE SUB upd ()
69. DECLARE SUB utc (t)
70. DECLARE SUB vwd ()
71. TYPE dd
72. ttl AS STRING * 21
73. ab AS STRING * 5
74. sty AS STRING * 1
75. c AS INTEGER
76. r AS INTEGER
77. r1 AS INTEGER
78. r2 AS INTEGER
79. r3 AS INTEGER
80. r4 AS INTEGER
81. rhot AS INTEGER
82. bc AS INTEGER
83. hue AS INTEGER
84. od AS INTEGER
85. oa AS INTEGER
86. id AS INTEGER
87. ia AS INTEGER
88. bdn AS INTEGER
89. bac AS INTEGER
90. own AS INTEGER
91. stat AS INTEGER
92. mop AS INTEGER
93. hk AS INTEGER
94. END TYPE
95. TYPE pl
96. ft AS STRING * 8
97. tk AS STRING * 1
98. c AS LONG
99. whr AS INTEGER
100. jc AS INTEGER
101. dc AS INTEGER
102. chag AS INTEGER
103. cheg AS INTEGER
104. END TYPE
105. ON ERROR GOTO 1
106. RANDOMIZE TIMER
107. DIM SHARED sf!, uf!, j, bn, x, q, fr&, bhu, bht, top(1 TO 6) AS STRING * 7, mdd(1 TO 6) AS STRING * 7, bot(1 TO 6) AS STRING * 7, cha(1 TO 16), che(1 TO 16), lot(39) AS dd, st(1 TO 2) AS pl
108. CLS
109. mb
110. md
111. swbd
112. cont t, nos
113. IF nos THEN
114. rules
115. bhu = 32
116. bht = 12
117. init
118. t = 1
119. END IF
120. IF st(1).whr > -10 THEN
121. LOCATE lot(st(1).whr).od, lot(st(1).whr).oa
122. PRINT st(1).tk
123. END IF
124. IF st(2).whr > -10 THEN
125. LOCATE lot(st(2).whr).id, lot(st(2).whr).ia
126. PRINT st(2).tk
127. END IF
128. DO
129. IF st(t).whr > -10 THEN tn t ELSE tj t
130. t = 3 - t
131. LOOP
132. 1
133. SELECT CASE ERR
134. CASE 53
135. nos = -1
136. RESUME NEXT
137. CASE 255
138. ce 10, "The save is faulty."
139. ce 11, "I will delete it."
140. p
141. nos = -1
142. CLOSE
143. KILL "monopoly.dat"
144. RESUME NEXT
145. CASE ELSE
146. box
147. ce 5, "Crash " + lts(ERR) + " has happened."
148. ce 7, "Take note of what was going on just before the crash."
149. ce 9, "Contact me at grahambhg@yahoo.com,"
150. ce 10, "and I will see what I can do."
151. crd
152. END SELECT
153. DATA ,,o,,,,,,,,,,23,78,21,72,,
154. DATA Mediterranean Avenue,MEDIT,b,60,2,10,30,90,160,250,50,5,23,68,21,68,22,65
155. DATA ,,o,,,,,,,,,,23,61,21,61,,
156. DATA Baltic Avenue,BALTI,b,60,4,20,60,180,320,450,50,5,23,54,21,54,22,51
157. DATA ,,o,,,,,,,,,,23,47,21,47,,
158. DATA Reading Railroad,READR,r,200,,25,50,100,200,,,7,23,40,21,40,,
159. DATA Oriental Avenue,ORIEN,b,100,6,30,90,270,400,550,50,11,23,33,21,33,22,30
160. DATA ,,o,,,,,,,,,,23,26,21,26,,
161. DATA Vermont Avenue,VERMO,b,100,6,30,90,270,400,550,50,11,23,19,21,19,22,16
162. DATA Conneticut Avenue,CONNE,b,120,8,40,100,300,450,600,50,11,23,12,21,12,22,9
163. DATA ,,o,,,,,,,,,,23,2,21,8,,
164. DATA Saint Charles Place,STCHA,b,140,10,50,150,450,625,750,100,13,20,2,20,9,20,8
165. DATA Electric Company,ELECT,u,150,,,,,,,,7,18,2,18,9,,
166. DATA States Avenue,STATE,b,140,10,50,150,450,625,750,100,13,16,2,16,9,16,8
167. DATA Virginia Avenue,VIRGI,b,160,12,60,180,500,700,900,100,13,14,2,14,9,14,8
168. DATA Pennsylvania Railroad,PENRR,r,200,,25,50,100,200,,,7,12,2,12,9,,
169. DATA Saint James Place,STJAM,b,180,14,70,200,550,750,950,100,12,10,2,10,9,10,8
170. DATA ,,o,,,,,,,,,,8,2,8,9,,
171. DATA Tennessee Avenue,TENNE,b,180,14,70,200,550,750,950,100,12,6,2,6,9,6,8
172. DATA New York Avenue,NEWYO,b,200,16,80,220,600,800,1000,100,12,4,2,4,9,4,8
173. DATA ,,o,,,,,,,,,,1,2,3,8,,
174. DATA Kentucky Avenue,KENTU,b,220,18,90,250,700,875,1050,150,4,1,12,3,12,2,15
175. DATA ,,o,,,,,,,,,,1,19,3,19,,
176. DATA Indiana Avenue,INDIA,b,220,18,90,250,700,875,1050,150,4,1,26,3,26,2,29
177. DATA Illinois Avenue,ILLIN,b,240,20,100,300,750,925,1100,150,4,1,33,3,33,2,36
178. DATA B. & O. Railroad,B&ORR,r,200,,25,50,100,200,,,7,1,40,3,40,,
179. DATA Atlantic Avenue,ATLAN,b,260,22,110,330,800,975,1150,150,14,1,47,3,47,2,50
180. DATA Ventnor Avenue,VENTN,b,260,22,110,330,800,975,1150,150,14,1,54,3,54,2,57
181. DATA Water Works,WATER,u,150,,,,,,,,7,1,61,3,61,,
182. DATA Marvin Gardens,MARVI,b,280,24,120,360,850,1025,1200,150,14,1,68,3,68,2,71
183. DATA ,,o,,,,,,,,,,1,78,3,72,,
184. DATA Pacific Avenue,PACIF,b,300,26,130,390,900,1100,1275,200,10,4,78,4,71,4,72
185. DATA North Carolina Avenue,NORTH,b,300,26,130,390,900,1100,1275,200,10,6,78,6,71,6,72
186. DATA ,,o,,,,,,,,,,8,78,8,71,,
187. DATA Pennsylvania Avenue,PENAV,b,320,28,150,450,1000,1200,1400,200,10,10,78,10,71,10,72
188. DATA Short Line,SHORT,r,200,,25,50,100,200,,,7,12,78,12,71,,
189. DATA ,,o,,,,,,,,,,14,78,14,71,,
190. DATA Park Place,PARKP,b,350,35,175,500,1100,1300,1500,200,9,16,78,16,71,16,72
191. DATA ,,o,,,,,,,,,,18,78,18,71,,
192. DATA Boardwalk,BOARD,b,400,50,200,600,1400,1700,2000,200,9,20,78,20,71,20,72
193.  
194. SUB act (rl, t)
195. SELECT CASE st(t).whr
196. CASE 0
197. ce 10, "You landed on Go."
198. IF bn THEN
199. st(t).c = st(t).c + 200
200. ce 11, "Collect $400."
201. ELSE
202. ce 11, "Collect $200."
203. END IF
204. p
205. CASE 2, 17, 33
206. dche t
207. CASE 4
208. inc t
209. CASE 7, 22, 36
210. dcha t
211. CASE 10
212. ce 10, "Just visiting"
213. p
214. CASE 20
215. ce 10, "Free Parking"
216. IF j THEN
217. ce 11, "You get $" + ltsb(fr&)
218. st(t).c = st(t).c + fr&
219. fr& = 500
220. END IF
221. p
222. CASE 30
223. ar t
224. CASE 38
225. ce 10, "Luxury Tax. Pay $75."
226. p
227. pay t, 75
228. IF j THEN fr& = fr& + 75
229. p
230. CASE ELSE
231. lop rl, t
232. END SELECT
233. END SUB
234.  
235. FUNCTION ak$
236. DO
237. LOOP UNTIL INKEY$ = ""
238. DO
239. tx$ = LCASE$(INKEY$)
240. LOOP UNTIL tx$ > ""
241. ak = tx$
242. END FUNCTION
243.  
244. SUB ar (t)
245. ce 9, RTRIM$(st(t).ft) + " will be sent directly to Jail."
246. p
247. IF t = 1 THEN LOCATE lot(st(1).whr).od, lot(st(1).whr).oa ELSE LOCATE lot(st(2).whr).id, lot(st(2).whr).ia
248. PRINT " "
249. st(t).whr = -10
250. st(t).dc = 0
251. box
252. END SUB
253.  
254. SUB auc (t)
255. lwst = INT(.5 + lot(st(t).whr).c / 10)
256. bj = INT(.5 + lwst / 2)
257. nw = lwst
258. box
259. COLOR lot(st(t).whr).hue
260. ce 5, RTRIM$(lot(st(t).whr).ttl)
261. COLOR 15
262. ce 6, RTRIM$(st(1).ft) + ", you have $" + ltsb(st(1).c)
263. ce 7, "Do I hear $" + lts(nw) + "?"
264. IF cr(1) + st(1).c >= nw THEN ce 8, "(Y/N)" ELSE ce 8, "press N to Not bid."
265. DO
266. LOOP UNTIL INKEY$ = ""
267. DO
268. yn$ = LCASE$(INKEY$)
269. LOOP UNTIL yn$ = "n" OR (yn$ = "y" AND cr(1) + st(1).c >= nw)
270. IF yn$ = "y" THEN
271. ce 10, " I hear $" + lts(nw)
272. nw = nw + bj
273. bidder = 1
274. ELSE
275. ce 10, RTRIM$(st(1).ft) + " passes first bid."
276. END IF
277. clk .5
278. box
279. COLOR lot(st(t).whr).hue
280. ce 5, RTRIM$(lot(st(t).whr).ttl)
281. COLOR 15
282. ce 6, RTRIM$(st(2).ft) + ", you have $" + ltsb(st(2).c)
283. ce 7, "Do I hear $" + lts(nw) + "?"
284. IF cr(2) + st(2).c >= nw THEN ce 8, "(Y/N)" ELSE ce 8, "press N to Not bid."
285. DO
286. LOOP UNTIL INKEY$ = ""
287. DO
288. yn$ = LCASE$(INKEY$)
289. LOOP UNTIL yn$ = "n" OR (yn$ = "y" AND cr(2) + st(2).c >= nw)
290. IF yn$ = "y" THEN
291. ce 10, " I hear $" + lts(nw)
292. nw = nw + bj
293. bidder = 2
294. ELSE
295. ce 9, "Going, going, going..."
296. END IF
297. clk .5
298. SELECT CASE bidder
299. CASE 0
300. ce 11, "No sale!"
301. p
302. CASE 1
303. pay 1, lwst
304. COLOR lot(st(t).whr).hue
305. ce 10, RTRIM$(lot(st(t).whr).ttl)
306. COLOR 15
307. lot(st(t).whr).own = 1
308. p
309. CASE 2
310. who = 1
311. DO
312. box
313. COLOR lot(st(t).whr).hue
314. ce 5, RTRIM$(lot(st(t).whr).ttl)
315. COLOR 15
316. ce 6, RTRIM$(st(who).ft) + ", you have $" + ltsb(st(who).c)
317. ce 7, "Do I hear $" + lts(nw) + "?"
318. IF cr(who) + st(who).c >= nw THEN ce 8, "(Y/N)" ELSE ce 8, "press N to Not bid."
319. DO
320. LOOP UNTIL INKEY$ = ""
321. DO
322. yn$ = LCASE$(INKEY$)
323. LOOP UNTIL yn$ = "n" OR (yn$ = "y" AND cr(who) + st(who).c >= nw)
324. IF yn$ = "y" THEN
325. ce 10, " I hear $" + lts(nw)
326. nw = nw + bj
327. bidder = who
328. ELSE
329. ce 9, "Going, going, going..."
330. done = -1
331. END IF
332. clk .5
333. who = 3 - who
334. LOOP UNTIL done
335. COLOR lot(st(t).whr).hue
336. ce 10, RTRIM$(lot(st(t).whr).ttl)
337. COLOR 15
338. pay bidder, nw - bj
339. lot(st(t).whr).own = bidder
340. p
341. END SELECT
342. END SUB
343.  
344. SUB b
345. DO
346. LOOP UNTIL INKEY$ = ""
347. FOR al = 300 TO 500 STEP 100
348. SOUND al, 2
349. NEXT
350. END SUB
351.  
352. SUB bca (t, houf, hotf)
353. hss = chou(t)
354. hts = chot(t)
355. ce 8, RTRIM$(st(t).ft) + ", you have " + lts(hss) + " house(s) and " + lts(hts) + " hotel(s)."
356. fee = hss * houf + hts * hotf
357. ce 9, "$" + lts(fee) + " due."
358. p
359. IF fee = 0 THEN EXIT SUB
360. pay t, fee
361. p
362. IF j THEN fr& = fr& + fee
363. END SUB
364.  
365. SUB box
366. COLOR 8
367. ce 4, CHR$(201) + STRING$(59, 205) + CHR$(187)
368. FOR sides = 5 TO 17
369. ce sides, CHR$(186) + SPACE$(59) + CHR$(186)
370. NEXT
371. ce 18, CHR$(204) + STRING$(8, 205) + CHR$(187) + SPACE$(50) + CHR$(186)
372. ce 19, CHR$(186) + SPACE$(8) + CHR$(186) + SPACE$(50) + CHR$(186)
373. ce 20, CHR$(200) + STRING$(8, 205) + CHR$(202) + STRING$(50, 205) + CHR$(188)
374. COLOR 6
375. LOCATE 19, 11
376. PRINT "JAIL:"
377. COLOR 15
378. IF st(1).whr = -10 THEN
379. LOCATE 19, 16
380. PRINT st(1).tk
381. END IF
382. IF st(2).whr = -10 THEN
383. LOCATE 19, 18
384. PRINT st(2).tk
385. END IF
386. IF (NOT x) THEN
387. LOCATE 18, 61
388. PRINT USING "houses:##"; bhu
389. END IF
390. IF (NOT x) THEN
391. LOCATE 19, 61
392. PRINT USING "hotels:##"; bht
393. END IF
394. END SUB
395.  
396. SUB broke (t)
397. DO
398. box
399. owe = ABS(st(t).c)
400. v = cr(t)
401. ce 5, RTRIM$(st(t).ft) + ", you need to raise $" + lts(ABS(owe))
402. ce 6, "You can raise $" + lts(v)
403. IF owe > v THEN
404. ce 12, "YOU ARE BROKE!!"
405. ce 16, "press Q to Quit game"
406. DO
407. LOOP UNTIL INKEY$ = ""
408. DO
409. done$ = LCASE$(INKEY$)
410. LOOP UNTIL done$ = "q"
411. gov 3 - t
412. END IF
413. ce 9, "press 4 to mortgage properties"
414. ce 10, "press 5 to sell houses"
415. ce 11, "press 6 to sell hotels"
416. ce 13, "press 8 to see inventories"
417. ce 14, "press 9 to view deeds"
418. ce 16, "press Q to Quit game"
419. DO
420. LOOP UNTIL INKEY$ = ""
421. DO
422. wtn$ = LCASE$(INKEY$)
423. wtn = VAL(wtn$)
424. LOOP UNTIL wtn$ > ""
425. IF wtn$ = "q" THEN quit
426. SELECT CASE wtn
427. CASE 4
428. mort t
429. CASE 5
430. shou t
431. swbs
432. CASE 6
433. shot t
434. swbs
435. CASE 8
436. inv
437. CASE 9
438. vwd
439. END SELECT
440. LOOP UNTIL st(t).c >= 0
441. box
442. END SUB
443.  
444. SUB buhot (t)
445. DIM gm(9)
446. gm(0) = -1
447. box
448. IF lot(1).own = t AND lot(1).stat = 4 AND st(t).c >= 50 AND bht > 0 THEN
449. gm(1) = -1
450. mini 1
451. END IF
452. IF lot(6).own = t AND lot(6).stat = 4 AND st(t).c >= 50 AND bht > 0 THEN
453. gm(2) = -1
454. mini 2
455. END IF
456. IF lot(11).own = t AND lot(11).stat = 4 AND st(t).c >= 100 AND bht > 0 THEN
457. gm(3) = -1
458. mini 3
459. END IF
460. IF lot(16).own = t AND lot(16).stat = 4 AND st(t).c >= 100 AND bht > 0 THEN
461. gm(4) = -1
462. mini 4
463. END IF
464. IF lot(21).own = t AND lot(21).stat = 4 AND st(t).c >= 150 AND bht > 0 THEN
465. gm(5) = -1
466. mini 5
467. END IF
468. IF lot(26).own = t AND lot(26).stat = 4 AND st(t).c >= 150 AND bht > 0 THEN
469. gm(6) = -1
470. mini 6
471. END IF
472. IF lot(31).own = t AND lot(31).stat = 4 AND st(t).c >= 200 AND bht > 0 THEN
473. gm(7) = -1
474. mini 7
475. END IF
476. IF lot(37).own = t AND lot(37).stat = 4 AND st(t).c >= 200 AND bht > 0 THEN
477. gm(8) = -1
478. mini 8
479. END IF
480. ce 9, RTRIM$(st(t).ft)
481. ce 10, "Choose a monopoly to buy hotels for"
482. ce 11, "or 0 to continue"
483. DO
484. IF wlb > 0 AND (NOT q) THEN b
485. DO
486. LOOP UNTIL INKEY$ = ""
487. DO
488. wlb$ = INKEY$
489. IF wlb$ = CHR$(13) THEN wlb$ = "0"
490. LOOP UNTIL wlb$ > ""
491. IF wlb$ >= "0" AND wlb$ <= "8" THEN wlb = VAL(wlb$) ELSE wlb = 9
492. LOOP UNTIL gm(wlb)
493. IF wlb = 0 THEN EXIT SUB
494. box
495. ce 5, RTRIM$(st(t).ft)
496. pim wlb, l, m, h
497. SELECT CASE m
498. CASE 2
499. IF lot(h).stat = 5 THEN max = 1 ELSE max = 2
500. CASE ELSE
501. max = 3
502. IF lot(h).stat = 5 THEN max = 2
503. IF lot(m).stat = 5 THEN max = 1
504. END SELECT
505. IF max > bht THEN max = bht
506. IF max > INT(st(t).c / lot(l).bc) THEN max = INT(st(t).c / lot(l).bc)
507. ce 7, "you can buy up to " + lts(max) + " hotel(s)."
508. ce 8, "or 0 to continue"
509. ce 10, "you have $" + ltsb(st(t).c)
510. ce 11, "hotels cost $" + lts(lot(l).bc) + " (plus four houses) each."
511. quan = ner(9, max)
512. IF quan = 0 THEN EXIT SUB
513. tot = lot(l).stat + lot(m).stat + lot(h).stat + quan
514. SELECT CASE m
515. CASE 2
516. lot(h).stat = INT(tot / 2)
517. lot(l).stat = INT(tot / 2)
518. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
519. CASE ELSE
520. lot(h).stat = INT(tot / 3)
521. lot(m).stat = INT(tot / 3)
522. lot(l).stat = INT(tot / 3)
523. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
524. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
525. END SELECT
526. pay t, lot(l).bc * quan
527. p
528. IF (NOT x) THEN
529. bht = bht - quan
530. bhu = bhu + quan * 4
531. END IF
532. END SUB
533.  
534. SUB buhou (t)
535. DIM gm(9)
536. gm(0) = -1
537. box
538. IF lot(1).own = t AND lot(1).mop AND (NOT lot(1).hk) AND (NOT lot(3).hk) AND lot(1).stat < 4 AND st(t).c >= 50 AND bhu > 0 THEN
539. gm(1) = -1
540. mini 1
541. END IF
542. IF lot(6).own = t AND lot(6).mop AND (NOT lot(6).hk) AND (NOT lot(8).hk) AND (NOT lot(9).hk) AND lot(6).stat < 4 AND st(t).c >= 50 AND bhu > 0 THEN
543. gm(2) = -1
544. mini 2
545. END IF
546. IF lot(11).own = t AND lot(11).mop AND (NOT lot(11).hk) AND (NOT lot(13).hk) AND (NOT lot(14).hk) AND lot(11).stat < 4 AND st(t).c >= 100 AND bhu > 0 THEN
547. gm(3) = -1
548. mini 3
549. END IF
550. IF lot(16).own = t AND lot(16).mop AND (NOT lot(16).hk) AND (NOT lot(18).hk) AND (NOT lot(19).hk) AND lot(16).stat < 4 AND st(t).c >= 100 AND bhu > 0 THEN
551. gm(4) = -1
552. mini 4
553. END IF
554. IF lot(21).own = t AND lot(21).mop AND (NOT lot(21).hk) AND (NOT lot(23).hk) AND (NOT lot(24).hk) AND lot(21).stat < 4 AND st(t).c >= 150 AND bhu > 0 THEN
555. gm(5) = -1
556. mini 5
557. END IF
558. IF lot(26).own = t AND lot(26).mop AND (NOT lot(26).hk) AND (NOT lot(27).hk) AND (NOT lot(29).hk) AND lot(26).stat < 4 AND st(t).c >= 150 AND bhu > 0 THEN
559. gm(6) = -1
560. mini 6
561. END IF
562. IF lot(31).own = t AND lot(31).mop AND (NOT lot(31).hk) AND (NOT lot(32).hk) AND (NOT lot(34).hk) AND lot(31).stat < 4 AND st(t).c >= 200 AND bhu > 0 THEN
563. gm(7) = -1
564. mini 7
565. END IF
566. IF lot(37).own = t AND lot(37).mop AND (NOT lot(37).hk) AND (NOT lot(39).hk) AND lot(37).stat < 4 AND st(t).c >= 200 AND bhu > 0 THEN
567. gm(8) = -1
568. mini 8
569. END IF
570. ce 9, RTRIM$(st(t).ft)
571. ce 10, "Choose a monopoly to buy houses for"
572. ce 11, "or 0 to continue"
573. DO
574. IF wlb > 0 AND (NOT q) THEN b
575. DO
576. LOOP UNTIL INKEY$ = ""
577. DO
578. wlb$ = INKEY$
579. IF wlb$ = CHR$(13) THEN wlb$ = "0"
580. LOOP UNTIL wlb$ > ""
581. IF wlb$ >= "0" AND wlb$ <= "8" THEN wlb = VAL(wlb$) ELSE wlb = 9
582. LOOP UNTIL gm(wlb)
583. IF wlb = 0 THEN EXIT SUB
584. box
585. ce 5, RTRIM$(st(t).ft)
586. pim wlb, l, m, h
587. SELECT CASE m
588. CASE 2
589. max = 8 - lot(l).stat - lot(h).stat
590. CASE ELSE
591. max = 12 - lot(l).stat - lot(m).stat - lot(h).stat
592. END SELECT
593. IF max > bhu THEN max = bhu
594. IF max > INT(st(t).c / lot(l).bc) THEN max = INT(st(t).c / lot(l).bc)
595. ce 7, "you can buy up to " + lts(max) + " house(s)."
596. ce 8, "or 0 to continue"
597. ce 10, "you have $" + ltsb(st(t).c)
598. ce 11, "houses cost $" + lts(lot(l).bc) + " each."
599. quan = ner(9, max)
600. IF quan = 0 THEN EXIT SUB
601. tot = lot(l).stat + lot(m).stat + lot(h).stat + quan
602. SELECT CASE m
603. CASE 2
604. lot(h).stat = INT(tot / 2)
605. lot(l).stat = INT(tot / 2)
606. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
607. CASE ELSE
608. lot(h).stat = INT(tot / 3)
609. lot(m).stat = INT(tot / 3)
610. lot(l).stat = INT(tot / 3)
611. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
612. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
613. END SELECT
614. pay t, lot(l).bc * quan
615. p
616. IF (NOT x) THEN bhu = bhu - quan
617. END SUB
618.  
619. SUB ce (dn, tx$)
620. LOCATE dn, 40 - INT(LEN(tx$) / 2)
621. PRINT tx$
622. END SUB
623.  
624. SUB chk (l, m, h)
625. IF lot(l).own = lot(m).own AND lot(m).own = lot(h).own AND lot(l).own > 0 THEN
626. lot(l).mop = -1
627. lot(m).mop = -1
628. lot(h).mop = -1
629. ELSE
630. lot(l).mop = 0
631. lot(m).mop = 0
632. lot(h).mop = 0
633. END IF
634. END SUB
635.  
636. FUNCTION chot (t)
637. FOR sq = 1 TO 39
638. IF lot(sq).sty = "b" AND lot(sq).own = t AND lot(sq).stat = 5 THEN ced = ced + 1
639. NEXT
640. chot = ced
641. END FUNCTION
642.  
643. FUNCTION chou (t)
644. FOR sq = 1 TO 39
645. IF lot(sq).sty = "b" AND lot(sq).own = t AND lot(sq).stat < 5 THEN ced = ced + lot(sq).stat
646. NEXT
647. chou = ced
648. END FUNCTION
649.  
650. SUB clk (se!)
651. start# = TIMER
652. DO
653. IF se! >= .1 THEN
654. DO
655. LOOP UNTIL INKEY$ = ""
656. END IF
657. LOOP UNTIL TIMER < start# OR TIMER - start# >= se!
658. END SUB
659.  
660. SUB cont (t, nos)
661. OPEN "monopoly.dat" FOR INPUT AS #1
662. IF (NOT nos) THEN
663. ce 5, "I found a save."
664. ce 7, "Do you want to continue prior game? (Y/N)"
665. DO
666. yn$ = LCASE$(INKEY$)
667. LOOP UNTIL yn$ = "y" OR yn$ = "n"
668. ce 8, UCASE$(yn$)
669. p
670. IF yn$ = "n" THEN
671. CLOSE
672. nos = -1
673. EXIT SUB
674. END IF
675. INPUT #1, sf!
676. IF sf! <> 1 AND sf! <> .5 THEN GOTO oops
677. INPUT #1, uf!
678. IF uf! <> .5 AND uf! <> .55 THEN GOTO oops
679. INPUT #1, t
680. IF t < 1 OR t > 2 THEN GOTO oops
681. INPUT #1, fr&
682. IF fr& < 0 THEN GOTO oops
683. INPUT #1, bhu
684. IF bhu < 0 OR bhu > 32 THEN GOTO oops
685. INPUT #1, bht
686. IF bht < 0 OR bht > 12 THEN GOTO oops
687. INPUT #1, j
688. IF j < -1 OR j > 0 THEN GOTO oops
689. INPUT #1, bn
690. IF bn < -1 OR bn > 0 THEN GOTO oops
691. INPUT #1, x
692. IF x < -1 OR x > 0 THEN GOTO oops
693. INPUT #1, q
694. IF q < -1 OR q > 0 THEN GOTO oops
695. FOR sq = 0 TO 39
696. INPUT #1, lot(sq).own
697. IF lot(sq).own < 0 OR lot(sq).own > 2 THEN GOTO oops
698. INPUT #1, lot(sq).stat
699. IF lot(sq).stat < 0 OR lot(sq).stat > 5 THEN GOTO oops
700. INPUT #1, lot(sq).mop
701. IF lot(sq).mop < -1 OR lot(sq).mop > 0 THEN GOTO oops
702. INPUT #1, lot(sq).hk
703. IF lot(sq).hk < -1 OR lot(sq).hk > 0 THEN GOTO oops
704. NEXT
705. FOR sq = 1 TO 2
706. INPUT #1, st(sq).ft
707. INPUT #1, st(sq).tk
708. INPUT #1, st(sq).c
709. IF st(sq).c < 0 THEN GOTO oops
710. INPUT #1, st(sq).whr
711. IF (st(sq).whr < 0 OR st(sq).whr > 39) AND st(sq).whr <> -10 THEN GOTO oops
712. INPUT #1, st(sq).jc
713. IF st(sq).jc < 0 OR st(sq).jc > 2 THEN GOTO oops
714. INPUT #1, st(sq).dc
715. IF st(sq).dc < 0 OR st(sq).dc > 2 THEN GOTO oops
716. INPUT #1, st(sq).chag
717. IF st(sq).chag < -1 OR st(sq).chag > 0 THEN GOTO oops
718. INPUT #1, st(sq).cheg
719. IF st(sq).cheg < -1 OR st(sq).cheg > 0 THEN GOTO oops
720. NEXT
721. FOR sq = 1 TO 16
722. INPUT #1, cha(sq)
723. IF cha(sq) < 0 OR cha(sq) > 2 THEN GOTO oops
724. INPUT #1, che(sq)
725. IF che(sq) < 0 OR che(sq) > 2 THEN GOTO oops
726. NEXT
727. CLOSE
728. KILL "monopoly.dat"
729. upd
730. END IF
731. EXIT SUB
732. oops:
733. ERROR 255
734. END SUB
735.  
736. FUNCTION cr (t)
737. FOR sq = 1 TO 39
738. IF lot(sq).own = t THEN
739. IF (NOT lot(sq).hk) THEN current = current + lot(sq).c / 2
740. IF lot(sq).sty = "b" THEN current = current + lot(sq).bc * lot(sq).stat * sf!
741. END IF
742. NEXT
743. cr = current
744. END FUNCTION
745.  
746. SUB crd
747. ce 12, "Program written by Brian H. Graham."
748. ce 13, "Based on the board game 'Monopoly' by Parker Brothers."
749. p
750. LOCATE 25, 1
751. COLOR 7
752. SYSTEM
753. END SUB
754.  
755. FUNCTION cw (t)
756. FOR sq = 1 TO 39
757. IF lot(sq).own = t THEN
758. IF lot(sq).hk THEN current = current + lot(sq).c / 2 ELSE current = current + lot(sq).c
759. IF lot(sq).sty = "b" THEN current = current + lot(sq).bc * lot(sq).stat
760. END IF
761. NEXT
762. cw = current + st(t).c
763. END FUNCTION
764.  
765. SUB dcha (t)
766. FOR look = 1 TO 16
767. IF cha(look) > 0 THEN ucha = ucha + 1
768. NEXT
769. IF ucha = 16 THEN scha
770. box
771. ce 5, RTRIM$(st(t).ft)
772. DO
773. cd = INT(RND * 16) + 1
774. LOOP UNTIL cha(cd) = 0
775. cha(cd) = 1
776. COLOR 12
777. ce 6, "Chance"
778. COLOR 15
779. SELECT CASE cd
780. CASE 1
781. ce 7, "Advance to Go. (Collect $200.)"
782. p
783. move 40 - st(t).whr, t
784. p
785. CASE 2
786. ce 7, "Advance to Illinois Avenue."
787. p
788. IF st(t).whr < 24 THEN move 24 - st(t).whr, t ELSE move 64 - st(t).whr, t
789. lop rl, t
790. CASE 3
791. ce 7, "Advance to the nearest Utility."
792. ce 8, "If it is owned, roll the dice,"
793. ce 9, "and pay the own ten times the amount shown."
794. ce 10, "If it is not owned, you may buy it."
795. p
796. SELECT CASE st(t).whr
797. CASE 7
798. move 12 - st(t).whr, t
799. CASE 22
800. move 28 - st(t).whr, t
801. CASE 36
802. move 52 - st(t).whr, t
803. END SELECT
804. utc t
805. CASE 4, 5
806. ce 7, "Advance to the next Railroad."
807. ce 8, "If it is owned, pay the own double"
808. ce 9, "the rent he/she is usually entitled."
809. ce 10, "If it is not owned, you may buy it."
810. p
811. SELECT CASE st(t).whr
812. CASE 7
813. move 15 - st(t).whr, t
814. CASE 22
815. move 25 - st(t).whr, t
816. CASE 36
817. move 45 - st(t).whr, t
818. END SELECT
819. rlc t
820. CASE 6
821. ce 7, "Advance to Saint Charles Place."
822. ce 8, "If you pass Go, collect $200."
823. p
824. IF st(t).whr < 11 THEN move 11 - st(t).whr, t ELSE move 51 - st(t).whr, t
825. lop rl, t
826. CASE 7
827. ce 7, "Bank pays you dividend of $50."
828. st(t).c = st(t).c + 50
829. p
830. CASE 8
831. ce 7, "Get out of Jail free."
832. ce 8, "This card may be kept until used or traded."
833. cha(8) = 2
834. st(t).chag = -1
835. p
836. CASE 9
837. ce 7, "Go back three spaces."
838. p
839. mob t
840. act rl, t
841. CASE 10
842. ce 7, "Go directly to Jail."
843. ce 8, "Do not pass Go, Do not collect $200."
844. p
845. ar t
846. CASE 11
847. ce 7, "Make general repairs on all you properties."
848. ce 8, "Pay $25 per house, $100 per hotel."
849. bca t, 25, 100
850. CASE 12
851. ce 7, "Pay poor tax of $15."
852. p
853. pay t, 15
854. IF j THEN fr& = fr& + 15
855. p
856. CASE 13
857. ce 7, "Take a ride on the Reading."
858. ce 8, "Advance to Reading Railroad."
859. ce 9, "Collect $200 if you pass Go."
860. p
861. move 45 - st(t).whr, t
862. lop rl, t
863. CASE 14
864. ce 7, "Take a walk on the boardwalk."
865. ce 8, "Advance to Boardwalk."
866. p
867. move 39 - st(t).whr, t
868. lop rl, t
869. CASE 15
870. ce 7, "You have been elected chairman of the board."
871. ce 8, "Pay each player $50."
872. p
873. popp t, 50
874. CASE 16
875. ce 7, "Your building and loan matures. Collect $150."
876. st(t).c = st(t).c + 150
877. p
878. END SELECT
879. END SUB
880.  
881. SUB dche (t)
882. FOR look = 1 TO 16
883. IF che(look) > 0 THEN uche = uche + 1
884. NEXT
885. IF uche = 16 THEN sche
886. box
887. ce 5, RTRIM$(st(t).ft)
888. DO
889. cd = INT(RND * 16) + 1
890. LOOP UNTIL che(cd) = 0
891. che(cd) = 1
892. COLOR 14
893. ce 6, "Community Chest"
894. COLOR 15
895. SELECT CASE cd
896. CASE 1
897. ce 7, "Advance to Go. (Collect $200.)"
898. p
899. move 40 - st(t).whr, t
900. p
901. CASE 2
902. ce 7, "Bank error in your favor. Collect $200."
903. p
904. st(t).c = st(t).c + 200
905. CASE 3
906. ce 7, "Christmas fund matures. Collect $100."
907. p
908. st(t).c = st(t).c + 100
909. CASE 4
910. ce 7, "Doctor's fee. Pay $50."
911. p
912. pay t, 50
913. p
914. IF j THEN fr& = fr& + 50
915. CASE 5
916. ce 7, "From sale of stock you get $45."
917. p
918. st(t).c = st(t).c + 45
919. CASE 6
920. ce 7, "Get out of Jail free."
921. ce 8, "This card may be kept until used or traded."
922. che(6) = 2
923. st(t).cheg = -1
924. p
925. CASE 7
926. ce 7, "Go directly to Jail."
927. ce 8, "Do not pass Go, Do not collect $200."
928. p
929. ar t
930. CASE 8
931. ce 7, "Grand opera opening. Collect $50 from every player."
932. p
933. popp 3 - t, 50
934. CASE 9
935. ce 7, "Income tax refund. Collect $20."
936. p
937. st(t).c = st(t).c + 20
938. CASE 10
939. ce 7, "Life insurance matures. Collect $100."
940. p
941. st(t).c = st(t).c + 100
942. CASE 11
943. ce 7, "Pay hospital $100."
944. p
945. pay t, 100
946. p
947. IF j THEN fr& = fr& + 100
948. CASE 12
949. ce 7, "Pay school tax of $150."
950. p
951. pay t, 150
952. p
953. IF j THEN fr& = fr& + 150
954. CASE 13
955. ce 7, "Recieve for services $25."
956. p
957. st(t).c = st(t).c + 25
958. CASE 14
959. ce 7, "You are assesed for street repairs."
960. ce 8, "$40 per house, $115 per hotel."
961. bca t, 40, 115
962. CASE 15
963. ce 7, "You have won second prize in a beauty contest."
964. ce 8, "Collect $10."
965. p
966. st(t).c = st(t).c + 10
967. CASE 16
968. ce 7, "You inherit $100."
969. p
970. st(t).c = st(t).c + 100
971. END SELECT
972. END SUB
973.  
974. FUNCTION di (d1, d2)
975. d1 = INT(RND * 6) + 1
976. d2 = INT(RND * 6) + 1
977. di = d1 + d2
978. ce 14, CHR$(218) + STRING$(5, 196) + CHR$(191) + CHR$(218) + STRING$(5, 196) + CHR$(191)
979. ce 15, top(d1) + top(d2)
980. ce 16, mdd(d1) + mdd(d2)
981. ce 17, bot(d1) + bot(d2)
982. ce 18, CHR$(192) + STRING$(5, 196) + CHR$(217) + CHR$(192) + STRING$(5, 196) + CHR$(217)
983. END FUNCTION
984.  
985. SUB dy (wt)
986. PRINT wt;
987. COLOR lot(wt).hue
988. PRINT lot(wt).ab;
989. COLOR 15
990. PRINT " $";
991. IF lot(wt).hk THEN PRINT lts(INT(.5 + lot(wt).c * uf!)) ELSE PRINT lts(lot(wt).c / 2)
992. END SUB
993.  
994. SUB fd (rl1, rl2, d1, d2, d3, d4)
995. d1 = INT(RND * 6) + 1
996. d2 = INT(RND * 6) + 1
997. d3 = INT(RND * 6) + 1
998. d4 = INT(RND * 6) + 1
999. rl1 = d1 + d2
1000. rl2 = d3 + d4
1001. ce 13, RTRIM$(st(1).ft) + SPACE$(6) + RTRIM$(st(2).ft)
1002. ce 14, CHR$(218) + STRING$(5, 196) + CHR$(191) + CHR$(218) + STRING$(5, 196) + CHR$(191) + SPACE$(6) + CHR$(218) + STRING$(5, 196) + CHR$(191) + CHR$(218) + STRING$(5, 196) + CHR$(191)
1003. ce 15, top(d1) + top(d2) + SPACE$(6) + top(d3) + top(d4)
1004. ce 16, mdd(d1) + mdd(d2) + SPACE$(6) + mdd(d3) + mdd(d4)
1005. ce 17, bot(d1) + bot(d2) + SPACE$(6) + bot(d3) + bot(d4)
1006. ce 18, CHR$(192) + STRING$(5, 196) + CHR$(217) + CHR$(192) + STRING$(5, 196) + CHR$(217) + SPACE$(6) + CHR$(192) + STRING$(5, 196) + CHR$(217) + CHR$(192) + STRING$(5, 196) + CHR$(217)
1007. END SUB
1008.  
1009. SUB gov (t)
1010. st(1).whr = 0
1011. st(2).whr = 0
1012. x = -1
1013. CLS
1014. swbd
1015. IF t = 0 THEN
1016. ce 5, "This game was a tie!"
1017. ce 7, "Thank you for playing " + RTRIM$(st(1).ft) + " and " + RTRIM$(st(2).ft)
1018. ELSE
1019. ce 5, RTRIM$(st(t).ft) + " has won!!!"
1020. ce 8, "Better luck next time " + RTRIM$(st(3 - t).ft)
1021. END IF
1022. crd
1023. END SUB
1024.  
1025. SUB inc (t)
1026. box
1027. ce 5, RTRIM$(st(t).ft)
1028. ce 6, "Income Tax"
1029. ce 8, "press W to pay 10% of your Worth"
1030. ce 9, "press F to pay $200 Flat rate"
1031. DO
1032. LOOP UNTIL INKEY$ = ""
1033. DO
1034. taxopt$ = LCASE$(INKEY$)
1035. LOOP UNTIL taxopt$ = "f" OR taxopt$ = "w"
1036. IF taxopt$ = "f" THEN fee = 200 ELSE fee = INT(.5 + cw(t) / 10)
1037. ce 10, UCASE$(taxopt$) + ", $" + lts(fee) + " due."
1038. p
1039. pay t, fee
1040. p
1041. IF j THEN fr& = fr& + fee
1042. END SUB
1043.  
1044. SUB init
1045. alto$ = CHR$(2) + CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6) + CHR$(21) + CHR$(157) + CHR$(232) + CHR$(233) + CHR$(236)
1046. FOR wide = 1 TO 10
1047. wide$ = wide$ + MID$(alto$, wide, 1) + " "
1048. NEXT
1049. wide$ = RTRIM$(wide$)
1050. FOR sq = 1 TO 2
1051. DO
1052. box
1053. ce 5, "Player " + lts(sq) + " first name"
1054. who$ = ""
1055. DO
1056. ltr$ = txk
1057. IF ltr$ = CHR$(8) AND LEN(who$) > 0 THEN
1058. who$ = LEFT$(who$, (LEN(who$) - 1))
1059. ELSE
1060. IF ltr$ <> CHR$(13) AND ltr$ <> CHR$(8) THEN who$ = who$ + ltr$
1061. END IF
1062. IF LEN(who$) < 9 THEN
1063. ce 6, SPACE$(10)
1064. ce 6, who$
1065. END IF
1066. LOOP UNTIL ltr$ = CHR$(13) OR LEN(who$) = 10
1067. st(sq).ft = who$
1068. LOOP UNTIL st(1).ft <> st(2).ft AND st(sq).ft <> SPACE$(8)
1069. ce 7, "pick a token"
1070. ce 8, wide$
1071. ce 9, "1 2 3 4 5 6 7 8 9 0"
1072. IF hide > 0 THEN
1073. LOCATE 8, hide * 2 + 29
1074. PRINT " "
1075. LOCATE 9, hide * 2 + 29
1076. PRINT " "
1077. END IF
1078. DO
1079. LOOP UNTIL INKEY$ = ""
1080. DO
1081. pick$ = INKEY$
1082. pick = VAL(pick$)
1083. IF pick = 0 THEN pick = 10
1084. LOOP UNTIL pick$ >= "0" AND pick$ <= "9" AND pick <> hide
1085. hide = pick
1086. st(sq).tk = MID$(alto$, hide, 1)
1087. st(sq).c = 1500
1088. ce 11, lts(pick) + ", " + st(sq).tk
1089. p
1090. NEXT
1091. DO
1092. box
1093. fd rl1, rl2, d1, d2, d3, d4
1094. ce 5, "Determining who goes first:"
1095. ce 7, RTRIM$(st(1).ft) + " rolls " + lts(d1) + " + " + lts(d2) + " = " + lts(rl1)
1096. ce 8, RTRIM$(st(2).ft) + " rolls " + lts(d3) + " + " + lts(d4) + " + " + lts(rl2)
1097. IF rl1 = rl2 THEN
1098. ce 10, "No decision. I will try again."
1099. p
1100. END IF
1101. LOOP UNTIL rl1 <> rl2
1102. IF rl2 > rl1 THEN SWAP st(1), st(2)
1103. ce 10, "This means " + RTRIM$(st(1).ft) + " goes first."
1104. p
1105. END SUB
1106.  
1107. SUB inv
1108. FOR look = 0 TO 2
1109. box
1110. IF lot(1).own = look THEN
1111. LOCATE 5, 11
1112. lil 1
1113. END IF
1114. IF lot(3).own = look THEN
1115. LOCATE 6, 11
1116. lil 3
1117. END IF
1118. IF lot(5).own = look THEN
1119. LOCATE 7, 11
1120. lil 5
1121. END IF
1122. IF lot(6).own = look THEN
1123. LOCATE 8, 11
1124. lil 6
1125. END IF
1126. IF lot(8).own = look THEN
1127. LOCATE 9, 11
1128. lil 8
1129. END IF
1130. IF lot(9).own = look THEN
1131. LOCATE 10, 11
1132. lil 9
1133. END IF
1134. IF lot(11).own = look THEN
1135. LOCATE 5, 26
1136. lil 11
1137. END IF
1138. IF lot(12).own = look THEN
1139. LOCATE 6, 26
1140. lil 12
1141. END IF
1142. IF lot(13).own = look THEN
1143. LOCATE 7, 26
1144. lil 13
1145. END IF
1146. IF lot(14).own = look THEN
1147. LOCATE 8, 26
1148. lil 14
1149. END IF
1150. IF lot(15).own = look THEN
1151. LOCATE 9, 26
1152. lil 15
1153. END IF
1154. IF lot(16).own = look THEN
1155. LOCATE 10, 26
1156. lil 16
1157. END IF
1158. IF lot(18).own = look THEN
1159. LOCATE 11, 26
1160. lil 18
1161. END IF
1162. IF lot(19).own = look THEN
1163. LOCATE 12, 26
1164. lil 19
1165. END IF
1166. IF lot(21).own = look THEN
1167. LOCATE 5, 41
1168. lil 21
1169. END IF
1170. IF lot(23).own = look THEN
1171. LOCATE 6, 41
1172. lil 23
1173. END IF
1174. IF lot(24).own = look THEN
1175. LOCATE 7, 41
1176. lil 24
1177. END IF
1178. IF lot(25).own = look THEN
1179. LOCATE 8, 41
1180. lil 25
1181. END IF
1182. IF lot(26).own = look THEN
1183. LOCATE 9, 41
1184. lil 26
1185. END IF
1186. IF lot(27).own = look THEN
1187. LOCATE 10, 41
1188. lil 27
1189. END IF
1190. IF lot(28).own = look THEN
1191. LOCATE 11, 41
1192. lil 28
1193. END IF
1194. IF lot(29).own = look THEN
1195. LOCATE 12, 41
1196. lil 29
1197. END IF
1198. IF lot(31).own = look THEN
1199. LOCATE 5, 56
1200. lil 31
1201. END IF
1202. IF lot(32).own = look THEN
1203. LOCATE 6, 56
1204. lil 32
1205. END IF
1206. IF lot(34).own = look THEN
1207. LOCATE 7, 56
1208. lil 34
1209. END IF
1210. IF lot(35).own = look THEN
1211. LOCATE 8, 56
1212. lil 35
1213. END IF
1214. IF lot(37).own = look THEN
1215. LOCATE 9, 56
1216. lil 37
1217. END IF
1218. IF lot(39).own = look THEN
1219. LOCATE 10, 56
1220. lil 39
1221. END IF
1222. SELECT CASE look
1223. CASE 0
1224. ce 14, "unowned properties"
1225. IF j THEN ce 16, "Free Parking has $" + ltsb(fr&)
1226. CASE 1, 2
1227. IF st(look).chag THEN
1228. COLOR 12
1229. LOCATE 12, 11
1230. PRINT "GOOJF";
1231. COLOR 15
1232. PRINT " Chance"
1233. END IF
1234. IF st(look).cheg THEN
1235. COLOR 14
1236. LOCATE 12, 56
1237. PRINT "GOOJF";
1238. COLOR 15
1239. PRINT " Cm Chst"
1240. END IF
1241. ce 14, RTRIM$(st(look).ft) + ", your properties"
1242. ce 15, "you are the " + st(look).tk
1243. IF st(look).c >= 0 THEN ce 16, "you have $" + ltsb(st(look).c) ELSE ce 16, "you need to raise $" + lts(ABS(st(look).c))
1244. END SELECT
1245. p
1246. NEXT
1247. END SUB
1248.  
1249. SUB lil (wt)
1250. COLOR lot(wt).hue
1251. PRINT lot(wt).ab;
1252. COLOR 15
1253. IF lot(wt).hk THEN
1254. PRINT " mort"
1255. ELSE
1256. IF lot(wt).own > 0 THEN
1257. SELECT CASE lot(wt).stat
1258. CASE 0
1259. IF lot(wt).mop THEN PRINT " doubl" ELSE PRINT " plain"
1260. CASE 1
1261. SELECT CASE lot(wt).sty
1262. CASE "b"
1263. PRINT " 1 hse"
1264. CASE "r"
1265. PRINT " 1 rr"
1266. CASE "u"
1267. PRINT " 1 utl"
1268. END SELECT
1269. CASE 2
1270. SELECT CASE lot(wt).sty
1271. CASE "b"
1272. PRINT " 2 hses"
1273. CASE "r"
1274. PRINT " 2 rrs"
1275. CASE "u"
1276. PRINT " 2 utls"
1277. END SELECT
1278. CASE 3
1279. SELECT CASE lot(wt).sty
1280. CASE "b"
1281. PRINT " 3 hses"
1282. CASE "r"
1283. PRINT " 3 rrs"
1284. END SELECT
1285. CASE 4
1286. SELECT CASE lot(wt).sty
1287. CASE "b"
1288. PRINT " 4 hses"
1289. CASE "r"
1290. PRINT " 4 rrs"
1291. END SELECT
1292. CASE 5
1293. PRINT " hotel"
1294. END SELECT
1295. END IF
1296. END IF
1297. END SUB
1298.  
1299. SUB lop (rl, t)
1300. IF lot(st(t).whr).own = 0 THEN
1301. noo t
1302. EXIT SUB
1303. END IF
1304. IF lot(st(t).whr).own = t THEN
1305. COLOR lot(st(t).whr).hue
1306. ce 12, RTRIM$(lot(st(t).whr).ttl)
1307. COLOR 15
1308. ce 13, "is yours."
1309. p
1310. EXIT SUB
1311. END IF
1312. IF lot(st(t).whr).hk THEN
1313. COLOR lot(st(t).whr).hue
1314. ce 12, RTRIM$(lot(st(t).whr).ttl)
1315. COLOR 15
1316. ce 13, "is mortgaged."
1317. p
1318. EXIT SUB
1319. END IF
1320. SELECT CASE lot(st(t).whr).stat
1321. CASE 0
1322. IF lot(st(t).whr).mop THEN popp t, lot(st(t).whr).r * 2 ELSE popp t, lot(st(t).whr).r
1323. CASE 1
1324. IF lot(st(t).whr).sty = "u" THEN popp t, 4 * rl ELSE popp t, lot(st(t).whr).r1
1325. CASE 2
1326. IF lot(st(t).whr).sty = "u" THEN popp t, 10 * rl ELSE popp t, lot(st(t).whr).r2
1327. CASE 3
1328. popp t, lot(st(t).whr).r3
1329. CASE 4
1330. popp t, lot(st(t).whr).r4
1331. CASE 5
1332. popp t, lot(st(t).whr).rhot
1333. END SELECT
1334. END SUB
1335.  
1336. FUNCTION lts$ (nu)
1337. lts = LTRIM$(STR$(nu))
1338. END FUNCTION
1339.  
1340. FUNCTION ltsb$ (nu&)
1341. ltsb = LTRIM$(STR$(nu&))
1342. END FUNCTION
1343.  
1344. SUB mb
1345. FOR sq = 0 TO 39
1346. READ lot(sq).ttl
1347. READ lot(sq).ab
1348. READ lot(sq).sty
1349. READ lot(sq).c
1350. READ lot(sq).r
1351. READ lot(sq).r1
1352. READ lot(sq).r2
1353. READ lot(sq).r3
1354. READ lot(sq).r4
1355. READ lot(sq).rhot
1356. READ lot(sq).bc
1357. READ lot(sq).hue
1358. READ lot(sq).od
1359. READ lot(sq).oa
1360. READ lot(sq).id
1361. READ lot(sq).ia
1362. READ lot(sq).bdn
1363. READ lot(sq).bac
1364. NEXT
1365. END SUB
1366.  
1367. SUB md
1368. p0$ = CHR$(179) + SPACE$(5) + CHR$(179)
1369. p1a$ = CHR$(179) + "@" + SPACE$(4) + CHR$(179)
1370. p1b$ = CHR$(179) + SPACE$(2) + "@" + SPACE$(2) + CHR$(179)
1371. p1c$ = CHR$(179) + SPACE$(4) + "@" + CHR$(179)
1372. p2$ = CHR$(179) + "@" + SPACE$(3) + "@" + CHR$(179)
1373. top(1) = p0$
1374. mdd(1) = p1b$
1375. bot(1) = p0$
1376. top(2) = p1a$
1377. mdd(2) = p0$
1378. bot(2) = p1c$
1379. top(3) = p1a$
1380. mdd(3) = p1b$
1381. bot(3) = p1c$
1382. top(4) = p2$
1383. mdd(4) = p0$
1384. bot(4) = p2$
1385. top(5) = p2$
1386. mdd(5) = p1b$
1387. bot(5) = p2$
1388. top(6) = p2$
1389. mdd(6) = p2$
1390. bot(6) = p2$
1391. END SUB
1392.  
1393. SUB mini (gr)
1394. SELECT CASE gr
1395. CASE 1
1396. dn = 5
1397. ac = 11
1398. mophue = 5
1399. mopstr$ = "MEDIT/BALTI"
1400. CASE 2
1401. dn = 6
1402. ac = 11
1403. mophue = 11
1404. mopstr$ = "OREIN/VERMO/CONNE"
1405. CASE 3
1406. dn = 7
1407. ac = 11
1408. mophue = 13
1409. mopstr$ = "STCHA/STATE/VIRGI"
1410. CASE 4
1411. dn = 8
1412. ac = 11
1413. mophue = 12
1414. mopstr$ = "STJAM/TENNE/NEWYO"
1415. CASE 5
1416. dn = 5
1417. ac = 41
1418. mophue = 4
1419. mopstr$ = "KENTU/INDIA/ILLIN"
1420. CASE 6
1421. dn = 6
1422. ac = 41
1423. mophue = 14
1424. mopstr$ = "ATLAN/VENTN/MARVI"
1425. CASE 7
1426. dn = 7
1427. ac = 41
1428. mophue = 10
1429. mopstr$ = "PACIF/NORTH/PENAV"
1430. CASE 8
1431. dn = 8
1432. ac = 41
1433. mophue = 9
1434. mopstr$ = "PARKP/BOARD"
1435. END SELECT
1436. LOCATE dn, ac
1437. PRINT gr;
1438. COLOR mophue
1439. PRINT mopstr$
1440. COLOR 15
1441. END SUB
1442.  
1443. SUB mob (t)
1444. FOR sq = 0 TO 2
1445. IF t = 1 THEN LOCATE lot(st(1).whr - sq).od, lot(st(1).whr - sq).oa ELSE LOCATE lot(st(2).whr - sq).id, lot(st(2).whr - sq).ia
1446. PRINT " "
1447. IF t = 1 THEN LOCATE lot(st(1).whr - sq - 1).od, lot(st(1).whr - sq - 1).oa ELSE LOCATE lot(st(2).whr - sq - 1).id, lot(st(2).whr - sq - 1).ia
1448. PRINT st(t).tk
1449. clk .1
1450. NEXT
1451. st(t).whr = (st(t).whr - 3)
1452. END SUB
1453.  
1454. SUB more (t)
1455. DO
1456. box
1457. ce 5, RTRIM$(st(t).ft) + ", you have $" + ltsb(st(t).c)
1458. ce 6, "press 1 to unmortgage properties"
1459. ce 7, "press 2 to buy houses"
1460. ce 8, "press 3 to buy hotels"
1461. ce 9, "press 4 to mortgage properties"
1462. ce 10, "press 5 to sell houses"
1463. ce 11, "press 6 to sell hotels"
1464. ce 12, "press 7 to trade"
1465. ce 13, "press 8 to see inventories"
1466. ce 14, "press 9 to view deeds"
1467. ce 15, "press any other key to continue"
1468. wtn = VAL(ak)
1469. SELECT CASE wtn
1470. CASE 1
1471. unm t
1472. CASE 2
1473. buhou t
1474. swbs
1475. CASE 3
1476. buhot t
1477. swbs
1478. CASE 4
1479. mort t
1480. CASE 5
1481. shou t
1482. swbs
1483. CASE 6
1484. shot t
1485. swbs
1486. CASE 7
1487. trade
1488. upd
1489. CASE 8
1490. inv
1491. CASE 9
1492. vwd
1493. END SELECT
1494. LOOP UNTIL wtn = 0
1495. END SUB
1496.  
1497. SUB mort (t)
1498. DIM gp(39)
1499. gp(0) = -1
1500. box
1501. IF lot(1).own = t AND (NOT lot(1).hk) AND lot(3).stat = 0 THEN
1502. LOCATE 5, 11
1503. dy 1
1504. gp(1) = -1
1505. END IF
1506. IF lot(3).own = t AND (NOT lot(3).hk) AND lot(3).stat = 0 THEN
1507. LOCATE 6, 11
1508. dy 3
1509. gp(3) = -1
1510. END IF
1511. IF lot(5).own = t AND (NOT lot(5).hk) THEN
1512. LOCATE 7, 11
1513. dy 5
1514. gp(5) = -1
1515. END IF
1516. IF lot(6).own = t AND (NOT lot(6).hk) AND lot(9).stat = 0 THEN
1517. LOCATE 8, 11
1518. dy 6
1519. gp(6) = -1
1520. END IF
1521. IF lot(8).own = t AND (NOT lot(8).hk) AND lot(9).stat = 0 THEN
1522. LOCATE 9, 11
1523. dy 8
1524. gp(8) = -1
1525. END IF
1526. IF lot(9).own = t AND (NOT lot(9).hk) AND lot(9).stat = 0 THEN
1527. LOCATE 10, 11
1528. dy 9
1529. gp(9) = -1
1530. END IF
1531. IF lot(11).own = t AND (NOT lot(11).hk) AND lot(14).stat = 0 THEN
1532. LOCATE 5, 26
1533. dy 11
1534. gp(11) = -1
1535. END IF
1536. IF lot(12).own = t AND (NOT lot(12).hk) THEN
1537. LOCATE 6, 26
1538. dy 12
1539. gp(12) = -1
1540. END IF
1541. IF lot(13).own = t AND (NOT lot(13).hk) AND lot(14).stat = 0 THEN
1542. LOCATE 7, 26
1543. dy 13
1544. gp(13) = -1
1545. END IF
1546. IF lot(14).own = t AND (NOT lot(14).hk) AND lot(14).stat = 0 THEN
1547. LOCATE 8, 26
1548. dy 14
1549. gp(14) = -1
1550. END IF
1551. IF lot(15).own = t AND (NOT lot(15).hk) THEN
1552. LOCATE 9, 26
1553. dy 15
1554. gp(15) = -1
1555. END IF
1556. IF lot(16).own = t AND (NOT lot(16).hk) AND lot(19).stat = 0 THEN
1557. LOCATE 10, 26
1558. dy 16
1559. gp(16) = -1
1560. END IF
1561. IF lot(18).own = t AND (NOT lot(18).hk) AND lot(19).stat = 0 THEN
1562. LOCATE 11, 26
1563. dy 18
1564. gp(18) = -1
1565. END IF
1566. IF lot(19).own = t AND (NOT lot(19).hk) AND lot(19).stat = 0 THEN
1567. LOCATE 12, 26
1568. dy 19
1569. gp(19) = -1
1570. END IF
1571. IF lot(21).own = t AND (NOT lot(21).hk) AND lot(24).stat = 0 THEN
1572. LOCATE 5, 41
1573. dy 21
1574. gp(21) = -1
1575. END IF
1576. IF lot(23).own = t AND (NOT lot(23).hk) AND lot(24).stat = 0 THEN
1577. LOCATE 6, 41
1578. dy 23
1579. gp(23) = -1
1580. END IF
1581. IF lot(24).own = t AND (NOT lot(24).hk) AND lot(24).stat = 0 THEN
1582. LOCATE 7, 41
1583. dy 24
1584. gp(24) = -1
1585. END IF
1586. IF lot(25).own = t AND (NOT lot(25).hk) THEN
1587. LOCATE 8, 41
1588. dy 25
1589. gp(25) = -1
1590. END IF
1591. IF lot(26).own = t AND (NOT lot(26).hk) AND lot(29).stat = 0 THEN
1592. LOCATE 9, 41
1593. dy 26
1594. gp(26) = -1
1595. END IF
1596. IF lot(27).own = t AND (NOT lot(27).hk) AND lot(29).stat = 0 THEN
1597. LOCATE 10, 41
1598. dy 27
1599. gp(27) = -1
1600. END IF
1601. IF lot(28).own = t AND (NOT lot(28).hk) THEN
1602. LOCATE 11, 41
1603. dy 28
1604. gp(28) = -1
1605. END IF
1606. IF lot(29).own = t AND (NOT lot(29).hk) AND lot(29).stat = 0 THEN
1607. LOCATE 12, 41
1608. dy 29
1609. gp(29) = -1
1610. END IF
1611. IF lot(31).own = t AND (NOT lot(31).hk) AND lot(34).stat = 0 THEN
1612. LOCATE 5, 56
1613. dy 31
1614. gp(31) = -1
1615. END IF
1616. IF lot(32).own = t AND (NOT lot(32).hk) AND lot(34).stat = 0 THEN
1617. LOCATE 6, 56
1618. dy 32
1619. gp(32) = -1
1620. END IF
1621. IF lot(34).own = t AND (NOT lot(34).hk) AND lot(34).stat = 0 THEN
1622. LOCATE 7, 56
1623. dy 34
1624. gp(34) = -1
1625. END IF
1626. IF lot(35).own = t AND (NOT lot(35).hk) THEN
1627. LOCATE 8, 56
1628. dy 35
1629. gp(35) = -1
1630. END IF
1631. IF lot(37).own = t AND (NOT lot(37).hk) AND lot(39).stat = 0 THEN
1632. LOCATE 9, 56
1633. dy 37
1634. gp(37) = -1
1635. END IF
1636. IF lot(39).own = t AND (NOT lot(39).hk) AND lot(39).stat = 0 THEN
1637. LOCATE 10, 56
1638. dy 39
1639. gp(39) = -1
1640. END IF
1641. ce 13, RTRIM$(st(t).ft)
1642. ce 14, "Choose a deed to mortgage or 0 to continue"
1643. IF st(t).c >= 0 THEN ce 17, "you have $" + ltsb(st(t).c) ELSE ce 17, "you need to raise $" + lts(-st(t).c)
1644. DO
1645. IF (NOT gp(pick)) AND (NOT q) THEN b
1646. pick = ner(15, 39)
1647. LOOP UNTIL gp(pick)
1648. IF pick = 0 THEN EXIT SUB
1649. lot(pick).hk = -1
1650. st(t).c = st(t).c + lot(pick).c / 2
1651. END SUB
1652.  
1653. SUB move (dist, t)
1654. FOR sq = 0 TO dist - 1
1655. IF t = 1 THEN LOCATE lot((st(1).whr + sq) MOD 40).od, lot((st(1).whr + sq) MOD 40).oa ELSE LOCATE lot((st(2).whr + sq) MOD 40).id, lot((st(2).whr + sq) MOD 40).ia
1656. PRINT " "
1657. IF t = 1 THEN LOCATE lot((st(1).whr + sq + 1) MOD 40).od, lot((st(1).whr + sq + 1) MOD 40).oa ELSE LOCATE lot((st(2).whr + sq + 1) MOD 40).id, lot((st(2).whr + sq + 1) MOD 40).ia
1658. PRINT st(t).tk
1659. clk .1
1660. NEXT
1661. IF st(t).whr + dist >= 40 THEN st(t).c = st(t).c + 200
1662. IF st(t).whr + dist > 40 THEN
1663. box
1664. ce 5, RTRIM$(st(t).ft) + ", you collect $200 for passing Go."
1665. clk .9
1666. END IF
1667. st(t).whr = (st(t).whr + dist) MOD 40
1668. END SUB
1669.  
1670. FUNCTION ner (dn, max)
1671. IF max = 0 THEN mk = 2 ELSE mk = INT(LOG(max) / LOG(10)) + 2
1672. DO
1673. ce dn, SPACE$(10)
1674. IF num > 0 AND (NOT q) THEN b
1675. num = 0
1676. num$ = ""
1677. DO
1678. numk$ = nerk
1679. IF numk$ = CHR$(8) AND LEN(num$) > 0 THEN
1680. num$ = LEFT$(num$, (LEN(num$) - 1))
1681. ELSE
1682. IF numk$ <> CHR$(13) AND numk$ <> CHR$(8) THEN num$ = num$ + numk$
1683. END IF
1684. IF LEN(num$) < mk THEN
1685. ce dn, SPACE$(10)
1686. ce dn, num$
1687. END IF
1688. LOOP UNTIL numk$ = CHR$(13) OR LEN(num$) = mk
1689. num = VAL(num$)
1690. LOOP UNTIL num <= max
1691. ner = num
1692. END FUNCTION
1693.  
1694. FUNCTION nerb& (dn, max&)
1695. IF max& = 0 THEN mk = 2 ELSE mk = INT(LOG(max&) / LOG(10)) + 2
1696. DO
1697. ce dn, SPACE$(10)
1698. IF num& > 0 AND (NOT q) THEN b
1699. num& = 0
1700. num$ = ""
1701. DO
1702. numk$ = nerk
1703. IF numk$ = CHR$(8) AND LEN(num$) > 0 THEN
1704. num$ = LEFT$(num$, (LEN(num$) - 1))
1705. ELSE
1706. IF numk$ <> CHR$(13) AND numk$ <> CHR$(8) THEN num$ = num$ + numk$
1707. END IF
1708. IF LEN(num$) < mk THEN
1709. ce dn, SPACE$(10)
1710. ce dn, num$
1711. END IF
1712. LOOP UNTIL numk$ = CHR$(13) OR LEN(num$) = mk
1713. num& = VAL(num$)
1714. LOOP UNTIL num& <= max&
1715. nerb& = num&
1716. END FUNCTION
1717.  
1718. FUNCTION nerk$
1719. DO
1720. DO
1721. LOOP UNTIL INKEY$ = ""
1722. DO
1723. tx$ = INKEY$
1724. LOOP UNTIL tx$ > ""
1725. SELECT CASE tx$
1726. CASE "0" TO "9", CHR$(13), CHR$(8)
1727. valid = -1
1728. CASE ELSE
1729. valid = 0
1730. IF (NOT q) THEN b
1731. END SELECT
1732. LOOP UNTIL valid
1733. nerk = tx$
1734. END FUNCTION
1735.  
1736. SUB noo (t)
1737. box
1738. COLOR lot(st(t).whr).hue
1739. ce 5, RTRIM$(lot(st(t).whr).ttl)
1740. COLOR 7
1741. ce 6, "cost $" + lts(lot(st(t).whr).c)
1742. ce 7, "mortgage value $" + lts(lot(st(t).whr).c / 2)
1743. SELECT CASE lot(st(t).whr).sty
1744. CASE "b"
1745. ce 8, "rent $" + lts(lot(st(t).whr).r)
1746. ce 9, "rent with one house $" + lts(lot(st(t).whr).r1)
1747. ce 10, "rent with two houses $" + lts(lot(st(t).whr).r2)
1748. ce 11, "rent with three houses $" + lts(lot(st(t).whr).r3)
1749. ce 12, "rent with four houses $" + lts(lot(st(t).whr).r4)
1750. ce 13, "rent with hotel $" + lts(lot(st(t).whr).rhot)
1751. ce 14, "houses cost $" + lts(lot(st(t).whr).bc) + " each"
1752. ce 15, "hotel costs $" + lts(lot(st(t).whr).bc) + " plus 4 houses"
1753. COLOR 15
1754. CASE "u"
1755. COLOR 15
1756. ce 8, "rent with one Utility, four times dice"
1757. ce 9, "rent with two Utilities, ten times dice"
1758. CASE "r"
1759. COLOR 15
1760. ce 8, "rent with one Railroad $25"
1761. ce 9, "rent with two Railroads $50"
1762. ce 10, "rent with three Railroads $100"
1763. ce 11, "rent with four Railroads $200"
1764. END SELECT
1765. ce 16, RTRIM$(st(t).ft) + ", you have $" + ltsb(st(t).c)
1766. IF cr(t) + st(t).c >= lot(st(t).whr).c THEN ce 17, "press B to Buy"
1767. ce 18, "press A to Auction"
1768. DO
1769. LOOP UNTIL INKEY$ = ""
1770. DO
1771. wt$ = LCASE$(INKEY$)
1772. LOOP UNTIL wt$ = "a" OR (wt$ = "b" AND cr(t) + st(t).c >= lot(st(t).whr).c)
1773. box
1774. IF wt$ = "b" THEN
1775. pay t, lot(st(t).whr).c
1776. COLOR lot(st(t).whr).hue
1777. ce 10, RTRIM$(lot(st(t).whr).ttl)
1778. COLOR 15
1779. lot(st(t).whr).own = t
1780. p
1781. ELSE
1782. auc t
1783. END IF
1784. upd
1785. END SUB
1786.  
1787. SUB opt (t)
1788. DO
1789. box
1790. ce 5, RTRIM$(st(t).ft) + ", you have $" + ltsb(st(t).c)
1791. ce 6, "press P for Property options"
1792. ce 7, "press S to Save and exit"
1793. ce 8, "press Q to Quit game early"
1794. ce 9, "press any other key to continue"
1795. wt$ = ak
1796. SELECT CASE wt$
1797. CASE "s"
1798. save t
1799. CASE "p"
1800. more t
1801. CASE "q"
1802. quit
1803. CASE ELSE
1804. done = -1
1805. END SELECT
1806. LOOP UNTIL done
1807. END SUB
1808.  
1809. SUB p
1810. ce 19, "press any key."
1811. DO
1812. LOOP UNTIL INKEY$ > ""
1813. ce 19, SPACE$(14)
1814. END SUB
1815.  
1816. SUB pay (t, cge)
1817. st(t).c = st(t).c - cge
1818. IF st(t).c < 0 THEN broke t
1819. ce 12, RTRIM$(st(t).ft) + " paid $" + lts(cge)
1820. END SUB
1821.  
1822. SUB pim (gr, l, m, h)
1823. SELECT CASE gr
1824. CASE 1
1825. l = 1
1826. m = 2
1827. h = 3
1828. COLOR 5
1829. ce 6, "MEDIT/BALTI"
1830. CASE 2
1831. l = 6
1832. m = 8
1833. h = 9
1834. COLOR 11
1835. ce 6, "OREIN/VERMO/CONNE"
1836. CASE 3
1837. l = 11
1838. m = 13
1839. h = 14
1840. COLOR 13
1841. ce 6, "STCHA/STATE/VIRGI"
1842. CASE 4
1843. l = 16
1844. m = 18
1845. h = 19
1846. COLOR 12
1847. ce 6, "STJAM/TENNE/NEWYO"
1848. CASE 5
1849. l = 21
1850. m = 23
1851. h = 24
1852. COLOR 4
1853. ce 6, "KENTU/INDIA/ILLIN"
1854. CASE 6
1855. l = 26
1856. m = 27
1857. h = 29
1858. COLOR 14
1859. ce 6, "ATLAN/VENTN/MARVI"
1860. CASE 7
1861. l = 31
1862. m = 32
1863. h = 34
1864. COLOR 10
1865. ce 6, "PACIF/NORTH/PENAV"
1866. CASE 8
1867. l = 37
1868. m = 2
1869. h = 39
1870. COLOR 9
1871. ce 6, "PARKP/BOARD"
1872. END SELECT
1873. COLOR 15
1874. END SUB
1875.  
1876. SUB popp (t, cge)
1877. pay t, cge
1878. st(3 - t).c = st(3 - t).c + cge
1879. ce 13, " to " + RTRIM$(st(3 - t).ft)
1880. p
1881. END SUB
1882.  
1883. SUB quit
1884. DO
1885. LOOP UNTIL INKEY$ = ""
1886. DO
1887. quithue = ((quithue + 1) AND 15) OR 8
1888. COLOR quithue
1889. ce 17, "ARE YOU SURE YOU WANT TO QUIT? (Y/N)"
1890. clk .09
1891. yn$ = LCASE$(INKEY$)
1892. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1893. COLOR 15
1894. IF yn$ = "y" THEN
1895. IF st(1).c < 0 THEN gov 2
1896. IF st(2).c < 0 THEN gov 1
1897. worth1 = cw(1)
1898. worth2 = cw(2)
1899. IF worth1 > worth2 THEN gov 1
1900. IF worth2 > worth1 THEN gov 2
1901. gov 0
1902. END IF
1903. END SUB
1904.  
1905. SUB rlc (t)
1906. IF lot(st(t).whr).own = 0 THEN
1907. noo t
1908. EXIT SUB
1909. END IF
1910. IF lot(st(t).whr).own = t THEN
1911. COLOR lot(st(t).whr).hue
1912. ce 12, RTRIM$(lot(st(t).whr).ttl)
1913. COLOR 15
1914. ce 13, "is yours."
1915. p
1916. EXIT SUB
1917. END IF
1918. IF lot(st(t).whr).hk THEN
1919. COLOR lot(st(t).whr).hue
1920. ce 12, RTRIM$(lot(st(t).whr).ttl)
1921. COLOR 15
1922. ce 13, "is mortgaged."
1923. p
1924. EXIT SUB
1925. END IF
1926. SELECT CASE lot(st(t).whr).stat
1927. CASE 1
1928. popp t, 50
1929. CASE 2
1930. popp t, 100
1931. CASE 3
1932. popp t, 200
1933. CASE 4
1934. popp t, 400
1935. END SELECT
1936. END SUB
1937.  
1938. SUB rules
1939. x = -1
1940. box
1941. ce 5, "I will start a new game."
1942. ce 7, "Do you want the Free Parking jackpot? (Y/N)"
1943. DO
1944. LOOP UNTIL INKEY$ = ""
1945. DO
1946. yn$ = LCASE$(INKEY$)
1947. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1948. ce 8, UCASE$(yn$)
1949. IF yn$ = "y" THEN
1950. j = -1
1951. fr& = 500
1952. END IF
1953. ce 9, "Do you want the land on Go bonus? (Y/N)"
1954. DO
1955. LOOP UNTIL INKEY$ = ""
1956. DO
1957. yn$ = LCASE$(INKEY$)
1958. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1959. ce 10, UCASE$(yn$)
1960. IF yn$ = "y" THEN bn = -1
1961. ce 11, "Do you want unlimited buildings in the bank? (Y/N)"
1962. DO
1963. LOOP UNTIL INKEY$ = ""
1964. DO
1965. yn$ = LCASE$(INKEY$)
1966. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1967. ce 12, UCASE$(yn$)
1968. IF yn$ = "n" THEN x = 0
1969. ce 13, "Do you want to suspend mortgage interest? (Y/N)"
1970. DO
1971. LOOP UNTIL INKEY$ = ""
1972. DO
1973. yn$ = LCASE$(INKEY$)
1974. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1975. ce 14, UCASE$(yn$)
1976. IF yn$ = "y" THEN uf! = .5 ELSE uf! = .55
1977. ce 15, "Should builings sell back at full price? (Y/N)"
1978. DO
1979. LOOP UNTIL INKEY$ = ""
1980. DO
1981. yn$ = LCASE$(INKEY$)
1982. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1983. ce 16, UCASE$(yn$)
1984. IF yn$ = "y" THEN sf! = 1 ELSE sf! = .5
1985. ce 17, "Do you want quiet mode? (Y/N)"
1986. DO
1987. LOOP UNTIL INKEY$ = ""
1988. DO
1989. yn$ = LCASE$(INKEY$)
1990. LOOP UNTIL yn$ = "y" OR yn$ = "n"
1991. ce 18, UCASE$(yn$)
1992. IF yn$ = "y" THEN q = -1
1993. p
1994. END SUB
1995.  
1996. SUB save (t)
1997. ce 10, "to be continued."
1998. OPEN "monopoly.dat" FOR OUTPUT AS #1
1999. PRINT #1, sf!
2000. PRINT #1, uf!
2001. PRINT #1, t
2002. PRINT #1, fr&
2003. PRINT #1, bhu
2004. PRINT #1, bht
2005. PRINT #1, j
2006. PRINT #1, bn
2007. PRINT #1, x
2008. PRINT #1, q
2009. FOR sq = 0 TO 39
2010. PRINT #1, lot(sq).own
2011. PRINT #1, lot(sq).stat
2012. PRINT #1, lot(sq).mop
2013. PRINT #1, lot(sq).hk
2014. NEXT
2015. FOR sq = 1 TO 2
2016. PRINT #1, st(sq).ft
2017. PRINT #1, st(sq).tk
2018. PRINT #1, st(sq).c
2019. PRINT #1, st(sq).whr
2020. PRINT #1, st(sq).jc
2021. PRINT #1, st(sq).dc
2022. PRINT #1, st(sq).chag
2023. PRINT #1, st(sq).cheg
2024. NEXT
2025. FOR sq = 1 TO 16
2026. PRINT #1, cha(sq)
2027. PRINT #1, che(sq)
2028. NEXT
2029. CLOSE
2030. crd
2031. END SUB
2032.  
2033. SUB scha
2034. box
2035. ce 5, "Shuffling Chance cards."
2036. ce 6, "Please wait."
2037. clk 2
2038. IF cha(8) = 2 THEN goojfflag = -1
2039. FOR flip = 1 TO 16
2040. cha(flip) = 0
2041. NEXT
2042. IF goojfflag THEN cha(8) = 2
2043. END SUB
2044.  
2045. SUB sche
2046. box
2047. ce 5, "Shuffling Community Chest cards."
2048. ce 6, "Please wait."
2049. clk 2
2050. IF che(6) = 2 THEN goojfflag = -1
2051. FOR flip = 1 TO 16
2052. che(flip) = 0
2053. NEXT
2054. IF goojfflag THEN che(6) = 2
2055. END SUB
2056.  
2057. SUB short (t, l, m, h)
2058. IF lot(h).stat = 5 THEN
2059. lot(h).stat = 4
2060. bht = bht + 1
2061. st(t).c = st(t).c + lot(l).bc * sf!
2062. END IF
2063. IF lot(m).stat = 5 THEN
2064. lot(m).stat = 4
2065. bht = bht + 1
2066. st(t).c = st(t).c + lot(l).bc * sf!
2067. END IF
2068. IF lot(l).stat = 5 THEN
2069. lot(l).stat = 4
2070. bht = bht + 1
2071. st(t).c = st(t).c + lot(l).bc * sf!
2072. END IF
2073. quan = chou(1) + chou(2) - 32
2074. tot = lot(l).stat + lot(m).stat + lot(h).stat - quan
2075. SELECT CASE m
2076. CASE 2
2077. lot(h).stat = INT(tot / 2)
2078. lot(l).stat = INT(tot / 2)
2079. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
2080. CASE ELSE
2081. lot(h).stat = INT(tot / 3)
2082. lot(m).stat = INT(tot / 3)
2083. lot(l).stat = INT(tot / 3)
2084. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
2085. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
2086. END SELECT
2087. st(t).c = st(t).c + lot(l).bc * quan * sf!
2088. bhu = 0
2089. box
2090. ce 5, RTRIM$(st(t).ft)
2091. ce 7, "a housing shortage sale taken place."
2092. p
2093. END SUB
2094.  
2095. SUB shot (t)
2096. DIM gm(9)
2097. gm(0) = -1
2098. box
2099. IF lot(3).own = t AND lot(3).stat = 5 THEN
2100. gm(1) = -1
2101. mini 1
2102. END IF
2103. IF lot(9).own = t AND lot(9).stat = 5 THEN
2104. gm(2) = -1
2105. mini 2
2106. END IF
2107. IF lot(14).own = t AND lot(14).stat = 5 THEN
2108. gm(3) = -1
2109. mini 3
2110. END IF
2111. IF lot(19).own = t AND lot(19).stat = 5 THEN
2112. gm(4) = -1
2113. mini 4
2114. END IF
2115. IF lot(24).own = t AND lot(24).stat = 5 THEN
2116. gm(5) = -1
2117. mini 5
2118. END IF
2119. IF lot(29).own = t AND lot(29).stat = 5 THEN
2120. gm(6) = -1
2121. mini 6
2122. END IF
2123. IF lot(34).own = t AND lot(34).stat = 5 THEN
2124. gm(7) = -1
2125. mini 7
2126. END IF
2127. IF lot(39).own = t AND lot(39).stat = 5 THEN
2128. gm(8) = -1
2129. mini 8
2130. END IF
2131. ce 9, RTRIM$(st(t).ft)
2132. ce 10, "Choose a monopoly to sell hotels from"
2133. ce 11, "or 0 to continue"
2134. DO
2135. IF ws > 0 AND (NOT q) THEN b
2136. DO
2137. LOOP UNTIL INKEY$ = ""
2138. DO
2139. ws$ = INKEY$
2140. IF ws$ = CHR$(13) THEN ws$ = "0"
2141. LOOP UNTIL ws$ > ""
2142. IF ws$ >= "0" AND ws$ <= "8" THEN ws = VAL(ws$) ELSE ws = 9
2143. LOOP UNTIL gm(ws)
2144. IF ws = 0 THEN EXIT SUB
2145. box
2146. ce 5, RTRIM$(st(t).ft)
2147. pim ws, l, m, h
2148. SELECT CASE m
2149. CASE 2
2150. IF lot(l).stat = 5 THEN max = 2 ELSE max = 1
2151. CASE ELSE
2152. max = 1
2153. IF lot(m).stat = 5 THEN max = 2
2154. IF lot(l).stat = 5 THEN max = 3
2155. END SELECT
2156. ce 7, "you can sell up to " + lts(max) + " hotel(s)."
2157. ce 8, "or 0 to continue"
2158. IF st(t).c >= 0 THEN ce 11, "you have $" + ltsb(st(t).c) ELSE ce 11, "you need to raise $" + lts(-st(t).c)
2159. ce 12, "hotels sell for $" + lts(lot(l).bc * sf!) + " (minus four houses) each."
2160. quan = ner(9, max)
2161. IF quan = 0 THEN EXIT SUB
2162. tot = lot(l).stat + lot(m).stat + lot(h).stat - quan
2163. SELECT CASE m
2164. CASE 2
2165. lot(h).stat = INT(tot / 2)
2166. lot(l).stat = INT(tot / 2)
2167. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
2168. CASE ELSE
2169. lot(h).stat = INT(tot / 3)
2170. lot(m).stat = INT(tot / 3)
2171. lot(l).stat = INT(tot / 3)
2172. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
2173. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
2174. END SELECT
2175. st(t).c = st(t).c + lot(l).bc * quan * sf!
2176. IF (NOT x) THEN
2177. bht = bht + quan
2178. bhu = bhu - 4 * quan
2179. IF bhu < 0 THEN short t, l, m, h
2180. END IF
2181. END SUB
2182.  
2183. SUB shou (t)
2184. DIM gm(9)
2185. gm(0) = -1
2186. box
2187. IF lot(3).own = t AND lot(3).stat > 0 AND lot(3).stat < 5 THEN
2188. gm(1) = -1
2189. mini 1
2190. END IF
2191. IF lot(9).own = t AND lot(9).stat > 0 AND lot(9).stat < 5 THEN
2192. gm(2) = -1
2193. mini 2
2194. END IF
2195. IF lot(14).own = t AND lot(14).stat > 0 AND lot(14).stat < 5 THEN
2196. gm(3) = -1
2197. mini 3
2198. END IF
2199. IF lot(19).own = t AND lot(19).stat > 0 AND lot(19).stat < 5 THEN
2200. gm(4) = -1
2201. mini 4
2202. END IF
2203. IF lot(24).own = t AND lot(24).stat > 0 AND lot(24).stat < 5 THEN
2204. gm(5) = -1
2205. mini 5
2206. END IF
2207. IF lot(29).own = t AND lot(29).stat > 0 AND lot(29).stat < 5 THEN
2208. gm(6) = -1
2209. mini 6
2210. END IF
2211. IF lot(34).own = t AND lot(34).stat > 0 AND lot(34).stat < 5 THEN
2212. gm(7) = -1
2213. mini 7
2214. END IF
2215. IF lot(39).own = t AND lot(39).stat > 0 AND lot(39).stat < 5 THEN
2216. gm(8) = -1
2217. mini 8
2218. END IF
2219. ce 9, RTRIM$(st(t).ft)
2220. ce 10, "Choose a monopoly to sell houses from"
2221. ce 11, "or 0 to continue"
2222. DO
2223. IF ws > 0 AND (NOT q) THEN b
2224. DO
2225. LOOP UNTIL INKEY$ = ""
2226. DO
2227. ws$ = INKEY$
2228. IF ws$ = CHR$(13) THEN ws$ = "0"
2229. LOOP UNTIL ws$ > ""
2230. IF ws$ >= "0" AND ws$ <= "8" THEN ws = VAL(ws$) ELSE ws = 9
2231. LOOP UNTIL gm(ws)
2232. IF ws = 0 THEN EXIT SUB
2233. box
2234. ce 5, RTRIM$(st(t).ft)
2235. pim ws, l, m, h
2236. SELECT CASE m
2237. CASE 2
2238. max = lot(l).stat + lot(h).stat
2239. CASE ELSE
2240. max = lot(l).stat + lot(m).stat + lot(h).stat
2241. END SELECT
2242. ce 7, "you can sell up to " + lts(max) + " house(s)."
2243. ce 8, "or 0 to continue"
2244. IF st(t).c >= 0 THEN ce 11, "you have $" + ltsb(st(t).c) ELSE ce 11, "you need to raise $" + lts(-st(t).c)
2245. ce 12, "houses sell for $" + lts(lot(l).bc * sf!) + " each."
2246. quan = ner(9, max)
2247. IF quan = 0 THEN EXIT SUB
2248. tot = lot(l).stat + lot(m).stat + lot(h).stat - quan
2249. SELECT CASE m
2250. CASE 2
2251. lot(h).stat = INT(tot / 2)
2252. lot(l).stat = INT(tot / 2)
2253. IF lot(h).stat + lot(l).stat < tot THEN lot(h).stat = lot(h).stat + 1
2254. CASE ELSE
2255. lot(h).stat = INT(tot / 3)
2256. lot(m).stat = INT(tot / 3)
2257. lot(l).stat = INT(tot / 3)
2258. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(h).stat = lot(h).stat + 1
2259. IF lot(h).stat + lot(l).stat + lot(m).stat < tot THEN lot(m).stat = lot(m).stat + 1
2260. END SELECT
2261. st(t).c = st(t).c + lot(l).bc * quan * sf!
2262. IF (NOT x) THEN bhu = bhu + quan
2263. END SUB
2264.  
2265. SUB sml (wt)
2266. PRINT wt;
2267. lil wt
2268. END SUB
2269.  
2270. SUB swbd
2271. box
2272. COLOR 5
2273. LOCATE 22, 66
2274. PRINT "MEDIT"
2275. LOCATE 22, 52
2276. PRINT "BALTI"
2277. COLOR 11
2278. LOCATE 22, 31
2279. PRINT "ORIEN"
2280. LOCATE 22, 17
2281. PRINT "VERMO"
2282. LOCATE 22, 10
2283. PRINT "CONNE"
2284. COLOR 13
2285. LOCATE 20, 3
2286. PRINT "STCHA"
2287. LOCATE 16, 3
2288. PRINT "STATE"
2289. LOCATE 14, 3
2290. PRINT "VIRGI"
2291. COLOR 12
2292. LOCATE 10, 3
2293. PRINT "STJAM"
2294. LOCATE 6, 3
2295. PRINT "TENNE"
2296. LOCATE 4, 3
2297. PRINT "NEWYO"
2298. COLOR 4
2299. LOCATE 2, 10
2300. PRINT "KENTU"
2301. LOCATE 2, 24
2302. PRINT "INDIA"
2303. LOCATE 2, 31
2304. PRINT "ILLIN"
2305. COLOR 14
2306. LOCATE 2, 45
2307. PRINT "ATLAN"
2308. LOCATE 2, 52
2309. PRINT "VENTN"
2310. LOCATE 2, 66
2311. PRINT "MARVI"
2312. COLOR 10
2313. LOCATE 4, 73
2314. PRINT "PACIF"
2315. LOCATE 6, 73
2316. PRINT "NORTH"
2317. LOCATE 10, 73
2318. PRINT "PENAV"
2319. COLOR 9
2320. LOCATE 16, 73
2321. PRINT "PARKP"
2322. LOCATE 20, 73
2323. PRINT "BOARD"
2324. COLOR 7
2325. LOCATE 22, 38
2326. PRINT "READR"
2327. LOCATE 18, 3
2328. PRINT "ELECT"
2329. LOCATE 12, 3
2330. PRINT "PENRR"
2331. LOCATE 2, 38
2332. PRINT "B&ORR"
2333. LOCATE 2, 59
2334. PRINT "WATER"
2335. LOCATE 12, 73
2336. PRINT "SHORT"
2337. COLOR 15
2338. LOCATE 22, 73
2339. PRINT "<-GO<"
2340. LOCATE 22, 59
2341. PRINT "COMMU"
2342. LOCATE 22, 45
2343. PRINT "INCTX"
2344. LOCATE 22, 24
2345. PRINT "CHANC"
2346. LOCATE 22, 3
2347. PRINT "JUSTV"
2348. LOCATE 8, 3
2349. PRINT "COMMU"
2350. LOCATE 2, 3
2351. PRINT "FREEP"
2352. LOCATE 2, 17
2353. PRINT "CHANC"
2354. LOCATE 2, 73
2355. PRINT "GOTOJ"
2356. LOCATE 8, 73
2357. PRINT "COMMU"
2358. LOCATE 14, 73
2359. PRINT "CHANC"
2360. LOCATE 18, 73
2361. PRINT "LUXTX"
2362. END SUB
2363.  
2364. SUB swbs
2365. FOR sq = 1 TO 39
2366. IF lot(sq).sty = "b" THEN
2367. LOCATE lot(sq).bdn, lot(sq).bac
2368. IF (NOT lot(sq).mop) THEN
2369. PRINT " "
2370. ELSE
2371. SELECT CASE lot(sq).stat
2372. CASE 0 TO 4
2373. COLOR 0, 10
2374. PRINT USING "#"; lot(sq).stat
2375. CASE 5
2376. COLOR 0, 4
2377. PRINT "H"
2378. END SELECT
2379. COLOR 15, 0
2380. END IF
2381. END IF
2382. NEXT
2383. END SUB
2384.  
2385. SUB tiny (wt)
2386. PRINT wt;
2387. COLOR lot(wt).hue
2388. PRINT lot(wt).ab
2389. COLOR 15
2390. END SUB
2391.  
2392. SUB tj (t)
2393. st(t).jc = st(t).jc + 1
2394. box
2395. ce 5, RTRIM$(st(t).ft) + ", in Jail, turn " + lts(st(t).jc) + " with $" + ltsb(st(t).c)
2396. IF cr(t) + st(t).c >= 50 THEN ce 6, "press M to Make bail (pay $50)"
2397. IF st(t).chag OR st(t).cheg THEN ce 7, "press C to use 'get out of jail free' Card"
2398. ce 8, "press R to Roll dice"
2399. DO
2400. LOOP UNTIL INKEY$ = ""
2401. DO
2402. how$ = LCASE$(INKEY$)
2403. LOOP UNTIL how$ = "r" OR (how$ = "m" AND cr(t) + st(t).c >= 50) OR (how$ = "c" AND (st(t).chag OR st(t).cheg))
2404. box
2405. SELECT CASE how$
2406. CASE "r"
2407. ce 5, RTRIM$(st(t).ft) + ", roll " + lts(st(t).jc) + " done, with $" + ltsb(st(t).c)
2408. rlout = di(d1, d2)
2409. ce 10, lts(d1) + " + " + lts(d2) + " = " + lts(rlout)
2410. p
2411. IF d1 = d2 THEN
2412. st(t).jc = 0
2413. st(t).whr = 10
2414. box
2415. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2416. PRINT st(t).tk
2417. move rlout, t
2418. act rlout, t
2419. END IF
2420. IF st(t).jc = 3 THEN
2421. IF st(t).chag OR st(t).cheg THEN
2422. ce 6, "press M to Make bail (pay $50)"
2423. ce 7, "press C to use 'get out of jail free' Card"
2424. END IF
2425. DO
2426. LOOP UNTIL INKEY$ = ""
2427. DO
2428. payout$ = LCASE$(INKEY$)
2429. IF (NOT st(t).chag) AND (NOT st(t).cheg) THEN payout$ = "m"
2430. LOOP UNTIL payout$ = "m" OR payout$ = "c"
2431. SELECT CASE payout$
2432. CASE "m"
2433. pay t, 50
2434. IF j THEN fr& = fr& + 50
2435. CASE "c"
2436. IF st(t).chag AND st(t).cheg THEN
2437. ce 10, "Pick a card."
2438. ce 11, "Press A for chAnce"
2439. ce 12, "press O for cOmmunity che"
2440. END IF
2441. DO
2442. LOOP UNTIL INKEY$ = ""
2443. DO
2444. wtc$ = LCASE$(INKEY$)
2445. IF (NOT st(t).chag) THEN wtc$ = "o"
2446. IF (NOT st(t).cheg) THEN wtc$ = "a"
2447. LOOP UNTIL wtc$ = "a" OR wtc$ = "o"
2448. IF wtc$ = "a" THEN
2449. ce 13, "Chance card used."
2450. st(t).chag = 0
2451. cha(8) = 1
2452. ELSE
2453. ce 13, "Community Chest card used."
2454. st(t).cheg = 0
2455. che(6) = 1
2456. END IF
2457. END SELECT
2458. p
2459. st(t).jc = 0
2460. st(t).whr = 10
2461. box
2462. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2463. PRINT st(t).tk
2464. move rlout, t
2465. act rlout, t
2466. END IF
2467. opt t
2468. CASE "m"
2469. pay t, 50
2470. IF j THEN fr& = fr& + 50
2471. st(t).jc = 0
2472. p
2473. box
2474. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2475. PRINT st(t).tk
2476. st(t).whr = 10
2477. tn t
2478. CASE "c"
2479. IF st(t).chag AND st(t).cheg THEN
2480. ce 10, "Pick a card."
2481. ce 11, "Press A for chAnce"
2482. ce 12, "press O for cOmmunity che"
2483. END IF
2484. DO
2485. LOOP UNTIL INKEY$ = ""
2486. DO
2487. wtc$ = LCASE$(INKEY$)
2488. IF (NOT st(t).chag) THEN wtc$ = "o"
2489. IF (NOT st(t).cheg) THEN wtc$ = "a"
2490. LOOP UNTIL wtc$ = "a" OR wtc$ = "o"
2491. IF wtc$ = "a" THEN
2492. ce 13, "Chance card used."
2493. st(t).chag = 0
2494. cha(8) = 1
2495. ELSE
2496. ce 13, "Community Chest card used."
2497. st(t).cheg = 0
2498. che(6) = 1
2499. END IF
2500. p
2501. box
2502. IF t = 1 THEN LOCATE lot(10).od, lot(10).oa ELSE LOCATE lot(10).id, lot(10).ia
2503. PRINT st(t).tk
2504. st(t).jc = 0
2505. st(t).whr = 10
2506. tn t
2507. END SELECT
2508. END SUB
2509.  
2510. SUB tn (t)
2511. DO
2512. box
2513. ce 5, RTRIM$(st(t).ft) + " press any key to roll the dice."
2514. p
2515. box
2516. ce 5, RTRIM$(st(t).ft)
2517. rl = di(d1, d2)
2518. ce 7, lts(d1) + " + " + lts(d2) + " = " + lts(rl)
2519. IF d1 = d2 THEN st(t).dc = st(t).dc + 1 ELSE st(t).dc = 0
2520. SELECT CASE st(t).dc
2521. CASE 0
2522. clk 1.5
2523. CASE 1
2524. ce 8, "first doubles"
2525. clk 1.5
2526. CASE 2
2527. ce 8, "second doubles"
2528. clk 1.5
2529. CASE 3
2530. ce 8, "Third doubles"
2531. ar t
2532. END SELECT
2533. IF st(t).whr > -10 THEN
2534. move rl, t
2535. act rl, t
2536. END IF
2537. opt t
2538. LOOP UNTIL st(t).dc = 0
2539. END SUB
2540.  
2541. SUB trade
2542. DIM wit(41), cg(1 TO 2)
2543. FOR gvr = 1 TO 2
2544. DO
2545. REDIM mt(41)
2546. mt(0) = -1
2547. box
2548. IF lot(1).own = gvr AND lot(3).stat = 0 THEN
2549. LOCATE 5, 11
2550. sml 1
2551. mt(1) = -1
2552. END IF
2553. IF lot(3).own = gvr AND lot(3).stat = 0 THEN
2554. LOCATE 6, 11
2555. sml 3
2556. mt(3) = -1
2557. END IF
2558. IF lot(5).own = gvr THEN
2559. LOCATE 7, 11
2560. sml 5
2561. mt(5) = -1
2562. END IF
2563. IF lot(6).own = gvr AND lot(9).stat = 0 THEN
2564. LOCATE 8, 11
2565. sml 6
2566. mt(6) = -1
2567. END IF
2568. IF lot(8).own = gvr AND lot(9).stat = 0 THEN
2569. LOCATE 9, 11
2570. sml 8
2571. mt(8) = -1
2572. END IF
2573. IF lot(9).own = gvr AND lot(9).stat = 0 THEN
2574. LOCATE 10, 11
2575. sml 9
2576. mt(9) = -1
2577. END IF
2578. IF lot(11).own = gvr AND lot(14).stat = 0 THEN
2579. LOCATE 5, 25
2580. sml 11
2581. mt(11) = -1
2582. END IF
2583. IF lot(12).own = gvr THEN
2584. LOCATE 6, 25
2585. sml 12
2586. mt(12) = -1
2587. END IF
2588. IF lot(13).own = gvr AND lot(14).stat = 0 THEN
2589. LOCATE 7, 25
2590. sml 13
2591. mt(13) = -1
2592. END IF
2593. IF lot(14).own = gvr AND lot(14).stat = 0 THEN
2594. LOCATE 8, 25
2595. sml 14
2596. mt(14) = -1
2597. END IF
2598. IF lot(15).own = gvr THEN
2599. LOCATE 9, 25
2600. sml 15
2601. mt(15) = -1
2602. END IF
2603. IF lot(16).own = gvr AND lot(19).stat = 0 THEN
2604. LOCATE 10, 25
2605. sml 16
2606. mt(16) = -1
2607. END IF
2608. IF lot(18).own = gvr AND lot(19).stat = 0 THEN
2609. LOCATE 11, 25
2610. sml 18
2611. mt(18) = -1
2612. END IF
2613. IF lot(19).own = gvr AND lot(19).stat = 0 THEN
2614. LOCATE 12, 25
2615. sml 19
2616. mt(19) = -1
2617. END IF
2618. IF lot(21).own = gvr AND lot(24).stat = 0 THEN
2619. LOCATE 5, 40
2620. sml 21
2621. mt(21) = -1
2622. END IF
2623. IF lot(23).own = gvr AND lot(24).stat = 0 THEN
2624. LOCATE 6, 40
2625. sml 23
2626. mt(23) = -1
2627. END IF
2628. IF lot(24).own = gvr AND lot(24).stat = 0 THEN
2629. LOCATE 7, 40
2630. sml 24
2631. mt(24) = -1
2632. END IF
2633. IF lot(25).own = gvr THEN
2634. LOCATE 8, 40
2635. sml 25
2636. mt(25) = -1
2637. END IF
2638. IF lot(26).own = gvr AND lot(29).stat = 0 THEN
2639. LOCATE 9, 40
2640. sml 26
2641. mt(26) = -1
2642. END IF
2643. IF lot(27).own = gvr AND lot(29).stat = 0 THEN
2644. LOCATE 10, 40
2645. sml 27
2646. mt(27) = -1
2647. END IF
2648. IF lot(28).own = gvr THEN
2649. LOCATE 11, 40
2650. sml 28
2651. mt(28) = -1
2652. END IF
2653. IF lot(29).own = gvr AND lot(29).stat = 0 THEN
2654. LOCATE 12, 40
2655. sml 29
2656. mt(29) = -1
2657. END IF
2658. IF lot(31).own = gvr AND lot(34).stat = 0 THEN
2659. LOCATE 5, 55
2660. sml 31
2661. mt(31) = -1
2662. END IF
2663. IF lot(32).own = gvr AND lot(34).stat = 0 THEN
2664. LOCATE 6, 55
2665. sml 32
2666. mt(32) = -1
2667. END IF
2668. IF lot(34).own = gvr AND lot(34).stat = 0 THEN
2669. LOCATE 7, 55
2670. sml 34
2671. mt(34) = -1
2672. END IF
2673. IF lot(35).own = gvr THEN
2674. LOCATE 8, 55
2675. sml 35
2676. mt(35) = -1
2677. END IF
2678. IF lot(37).own = gvr AND lot(39).stat = 0 THEN
2679. LOCATE 9, 55
2680. sml 37
2681. mt(37) = -1
2682. END IF
2683. IF lot(39).own = gvr AND lot(39).stat = 0 THEN
2684. LOCATE 10, 55
2685. sml 39
2686. mt(39) = -1
2687. END IF
2688. IF st(gvr).chag THEN
2689. LOCATE 12, 11
2690. PRINT 40;
2691. COLOR 12
2692. PRINT "GOOJF"
2693. COLOR 15
2694. mt(40) = -1
2695. END IF
2696. IF st(gvr).cheg THEN
2697. LOCATE 12, 55
2698. PRINT 41;
2699. COLOR 14
2700. PRINT "GOOJF"
2701. COLOR 15
2702. mt(41) = -1
2703. END IF
2704. ce 13, RTRIM$(st(gvr).ft) + ", you have $" + ltsb(st(gvr).c)
2705. ce 14, "Choose a deed to trade or 0 to continue"
2706. DO
2707. pick = 0
2708. IF (NOT mt(pick)) AND (NOT q) THEN b
2709. pick = ner(15, 41)
2710. LOOP UNTIL mt(pick)
2711. SELECT CASE pick
2712. CASE 1 TO 39
2713. lot(pick).own = 0
2714. CASE 40
2715. st(gvr).chag = 0
2716. CASE 41
2717. st(gvr).cheg = 0
2718. END SELECT
2719. wit(pick) = gvr
2720. LOOP UNTIL pick = 0
2721. ce 16, "cash to give"
2722. cg(gvr) = nerb(17, st(gvr).c)
2723. NEXT
2724. IF cg(1) > cg(2) THEN
2725. box
2726. popp 1, cg(1) - cg(2)
2727. END IF
2728. IF cg(2) > cg(1) THEN
2729. box
2730. popp 2, cg(2) - cg(1)
2731. END IF
2732. IF wit(40) > 0 THEN st(3 - wit(40)).chag = -1
2733. IF wit(41) > 0 THEN st(3 - wit(41)).cheg = -1
2734. FOR flip = 1 TO 39
2735. IF wit(flip) > 0 AND (NOT lot(flip).hk) THEN
2736. lot(flip).own = 3 - wit(flip)
2737. wit(flip) = 0
2738. END IF
2739. NEXT
2740. FOR flip = 1 TO 39
2741. IF wit(flip) > 0 THEN
2742. lot(flip).own = 3 - wit(flip)
2743. box
2744. ce 5, RTRIM$(st(3 - wit(flip)).ft) + ", you have $" + ltsb(st(3 - wit(flip)).c)
2745. COLOR lot(flip).hue
2746. ce 6, RTRIM$(lot(flip).ttl)
2747. COLOR 15
2748. ce 7, "is mortgaged."
2749. IF st(3 - wit(flip)).c >= INT(.5 + lot(flip).c * uf!) THEN
2750. ce 8, "Do you want to unmortgage it now? (Y/N)"
2751. y = INT(.5 + lot(flip).c * uf!)
2752. n = INT(.5 + lot(flip).c * (uf! - .5))
2753. ce 9, "Y will cost $" + lts(y)
2754. IF n > 0 THEN ce 10, "N will cost $" + lts(n)
2755. DO
2756. LOOP UNTIL INKEY$ = ""
2757. DO
2758. yn$ = LCASE$(INKEY$)
2759. LOOP UNTIL yn$ = "y" OR yn$ = "n"
2760. ELSE
2761. yn$ = "n"
2762. END IF
2763. IF yn$ = "y" THEN
2764. pay 3 - wit(flip), y
2765. lot(flip).hk = 0
2766. ELSE
2767. IF n > 0 THEN
2768. pay 3 - wit(flip), n
2769. ce 14, "mortgaged property fee."
2770. END IF
2771. p
2772. END IF
2773. END IF
2774. NEXT
2775. END SUB
2776.  
2777. FUNCTION txk$
2778. DO
2779. DO
2780. LOOP UNTIL INKEY$ = ""
2781. DO
2782. tx$ = INKEY$
2783. LOOP UNTIL tx$ > ""
2784. SELECT CASE LCASE$(tx$)
2785. CASE "a" TO "z", CHR$(13), CHR$(8)
2786. valid = -1
2787. CASE ELSE
2788. valid = 0
2789. IF (NOT q) THEN b
2790. END SELECT
2791. LOOP UNTIL valid
2792. txk = tx$
2793. END FUNCTION
2794.  
2795. SUB unm (t)
2796. DIM gp(39)
2797. gp(0) = -1
2798. box
2799. IF lot(1).own = t AND lot(1).hk AND st(t).c >= INT(.5 + lot(1).c * uf!) THEN
2800. LOCATE 5, 11
2801. dy 1
2802. gp(1) = -1
2803. END IF
2804. IF lot(3).own = t AND lot(3).hk AND st(t).c >= INT(.5 + lot(3).c * uf!) THEN
2805. LOCATE 6, 11
2806. dy 3
2807. gp(3) = -1
2808. END IF
2809. IF lot(5).own = t AND lot(5).hk AND st(t).c >= INT(.5 + lot(5).c * uf!) THEN
2810. LOCATE 7, 11
2811. dy 5
2812. gp(5) = -1
2813. END IF
2814. IF lot(6).own = t AND lot(6).hk AND st(t).c >= INT(.5 + lot(6).c * uf!) THEN
2815. LOCATE 8, 11
2816. dy 6
2817. gp(6) = -1
2818. END IF
2819. IF lot(8).own = t AND lot(8).hk AND st(t).c >= INT(.5 + lot(8).c * uf!) THEN
2820. LOCATE 9, 11
2821. dy 8
2822. gp(8) = -1
2823. END IF
2824. IF lot(9).own = t AND lot(9).hk AND st(t).c >= INT(.5 + lot(9).c * uf!) THEN
2825. LOCATE 10, 11
2826. dy 9
2827. gp(9) = -1
2828. END IF
2829. IF lot(11).own = t AND lot(11).hk AND st(t).c >= INT(.5 + lot(11).c * uf!) THEN
2830. LOCATE 5, 26
2831. dy 11
2832. gp(11) = -1
2833. END IF
2834. IF lot(12).own = t AND lot(12).hk AND st(t).c >= INT(.5 + lot(12).c * uf!) THEN
2835. LOCATE 6, 26
2836. dy 12
2837. gp(12) = -1
2838. END IF
2839. IF lot(13).own = t AND lot(13).hk AND st(t).c >= INT(.5 + lot(13).c * uf!) THEN
2840. LOCATE 7, 26
2841. dy 13
2842. gp(13) = -1
2843. END IF
2844. IF lot(14).own = t AND lot(14).hk AND st(t).c >= INT(.5 + lot(14).c * uf!) THEN
2845. LOCATE 8, 26
2846. dy 14
2847. gp(14) = -1
2848. END IF
2849. IF lot(15).own = t AND lot(15).hk AND st(t).c >= INT(.5 + lot(15).c * uf!) THEN
2850. LOCATE 9, 26
2851. dy 15
2852. gp(15) = -1
2853. END IF
2854. IF lot(16).own = t AND lot(16).hk AND st(t).c >= INT(.5 + lot(16).c * uf!) THEN
2855. LOCATE 10, 26
2856. dy 16
2857. gp(16) = -1
2858. END IF
2859. IF lot(18).own = t AND lot(18).hk AND st(t).c >= INT(.5 + lot(18).c * uf!) THEN
2860. LOCATE 11, 26
2861. dy 18
2862. gp(18) = -1
2863. END IF
2864. IF lot(19).own = t AND lot(19).hk AND st(t).c >= INT(.5 + lot(19).c * uf!) THEN
2865. LOCATE 12, 26
2866. dy 19
2867. gp(19) = -1
2868. END IF
2869. IF lot(21).own = t AND lot(21).hk AND st(t).c >= INT(.5 + lot(21).c * uf!) THEN
2870. LOCATE 5, 41
2871. dy 21
2872. gp(21) = -1
2873. END IF
2874. IF lot(23).own = t AND lot(23).hk AND st(t).c >= INT(.5 + lot(23).c * uf!) THEN
2875. LOCATE 6, 41
2876. dy 23
2877. gp(23) = -1
2878. END IF
2879. IF lot(24).own = t AND lot(24).hk AND st(t).c >= INT(.5 + lot(24).c * uf!) THEN
2880. LOCATE 7, 41
2881. dy 24
2882. gp(24) = -1
2883. END IF
2884. IF lot(25).own = t AND lot(25).hk AND st(t).c >= INT(.5 + lot(25).c * uf!) THEN
2885. LOCATE 8, 41
2886. dy 25
2887. gp(25) = -1
2888. END IF
2889. IF lot(26).own = t AND lot(26).hk AND st(t).c >= INT(.5 + lot(26).c * uf!) THEN
2890. LOCATE 9, 41
2891. dy 26
2892. gp(26) = -1
2893. END IF
2894. IF lot(27).own = t AND lot(27).hk AND st(t).c >= INT(.5 + lot(27).c * uf!) THEN
2895. LOCATE 10, 41
2896. dy 27
2897. gp(27) = -1
2898. END IF
2899. IF lot(28).own = t AND lot(28).hk AND st(t).c >= INT(.5 + lot(28).c * uf!) THEN
2900. LOCATE 11, 41
2901. dy 28
2902. gp(28) = -1
2903. END IF
2904. IF lot(29).own = t AND lot(29).hk AND st(t).c >= INT(.5 + lot(29).c * uf!) THEN
2905. LOCATE 12, 41
2906. dy 29
2907. gp(29) = -1
2908. END IF
2909. IF lot(31).own = t AND lot(31).hk AND st(t).c >= INT(.5 + lot(31).c * uf!) THEN
2910. LOCATE 5, 56
2911. dy 31
2912. gp(31) = -1
2913. END IF
2914. IF lot(32).own = t AND lot(32).hk AND st(t).c >= INT(.5 + lot(32).c * uf!) THEN
2915. LOCATE 6, 56
2916. dy 32
2917. gp(32) = -1
2918. END IF
2919. IF lot(34).own = t AND lot(34).hk AND st(t).c >= INT(.5 + lot(34).c * uf!) THEN
2920. LOCATE 7, 56
2921. dy 34
2922. gp(34) = -1
2923. END IF
2924. IF lot(35).own = t AND lot(35).hk AND st(t).c >= INT(.5 + lot(35).c * uf!) THEN
2925. LOCATE 8, 56
2926. dy 35
2927. gp(35) = -1
2928. END IF
2929. IF lot(37).own = t AND lot(37).hk AND st(t).c >= INT(.5 + lot(37).c * uf!) THEN
2930. LOCATE 9, 56
2931. dy 37
2932. gp(37) = -1
2933. END IF
2934. IF lot(39).own = t AND lot(39).hk AND st(t).c >= INT(.5 + lot(39).c * uf!) THEN
2935. LOCATE 10, 56
2936. dy 39
2937. gp(39) = -1
2938. END IF
2939. ce 13, RTRIM$(st(t).ft)
2940. ce 14, "Choose a deed to unmortgage or 0 to continue"
2941. ce 17, "you have $" + ltsb(st(t).c)
2942. DO
2943. IF (NOT gp(pick)) AND (NOT q) THEN b
2944. pick = ner(15, 39)
2945. LOOP UNTIL gp(pick)
2946. IF pick = 0 THEN EXIT SUB
2947. lot(pick).hk = 0
2948. box
2949. pay t, INT(.5 + lot(pick).c * uf!)
2950. p
2951. END SUB
2952.  
2953. SUB upd
2954. chk 1, 1, 3
2955. chk 6, 8, 9
2956. chk 11, 13, 14
2957. chk 16, 18, 19
2958. chk 21, 23, 24
2959. chk 26, 27, 29
2960. chk 31, 32, 34
2961. chk 37, 37, 39
2962. IF lot(12).own = lot(28).own AND lot(12).own > 0 THEN
2963. lot(12).stat = 2
2964. lot(28).stat = 2
2965. ELSE
2966. lot(12).stat = SGN(lot(12).own)
2967. lot(28).stat = SGN(lot(28).own)
2968. END IF
2969. FOR rtt = 5 TO 35 STEP 10
2970. rro = rro * 10 + lot(rtt).own
2971. lot(rtt).stat = 0
2972. NEXT
2973. SELECT CASE rro
2974. CASE 1111, 2222
2975. lot(5).stat = 4
2976. lot(15).stat = 4
2977. lot(25).stat = 4
2978. lot(35).stat = 4
2979. CASE 111, 222, 1222, 2111
2980. lot(15).stat = 3
2981. lot(25).stat = 3
2982. lot(35).stat = 3
2983. CASE 1011, 1211, 2022, 2122
2984. lot(5).stat = 3
2985. lot(25).stat = 3
2986. lot(35).stat = 3
2987. CASE 1101, 1121, 2202, 2212
2988. lot(5).stat = 3
2989. lot(15).stat = 3
2990. lot(35).stat = 3
2991. CASE 1110, 1112, 2220, 2221
2992. lot(5).stat = 3
2993. lot(15).stat = 3
2994. lot(25).stat = 3
2995. CASE ELSE
2996. IF lot(5).own = lot(15).own AND lot(5).own > 0 THEN
2997. lot(5).stat = 2
2998. lot(15).stat = 2
2999. END IF
3000. IF lot(5).own = lot(25).own AND lot(5).own > 0 THEN
3001. lot(5).stat = 2
3002. lot(25).stat = 2
3003. END IF
3004. IF lot(5).own = lot(35).own AND lot(5).own > 0 THEN
3005. lot(5).stat = 2
3006. lot(35).stat = 2
3007. END IF
3008. IF lot(15).own = lot(25).own AND lot(15).own > 0 THEN
3009. lot(15).stat = 2
3010. lot(25).stat = 2
3011. END IF
3012. IF lot(15).own = lot(35).own AND lot(15).own > 0 THEN
3013. lot(15).stat = 2
3014. lot(35).stat = 2
3015. END IF
3016. IF lot(25).own = lot(35).own AND lot(25).own > 0 THEN
3017. lot(25).stat = 2
3018. lot(35).stat = 2
3019. END IF
3020. END SELECT
3021. FOR rtt = 5 TO 35 STEP 10
3022. IF lot(rtt).stat = 0 THEN lot(rtt).stat = SGN(lot(rtt).own)
3023. NEXT
3024. swbs
3025. END SUB
3026.  
3027. SUB utc (t)
3028. IF lot(st(t).whr).own = 0 THEN
3029. noo t
3030. EXIT SUB
3031. END IF
3032. IF lot(st(t).whr).own = t THEN
3033. COLOR lot(st(t).whr).hue
3034. ce 12, RTRIM$(lot(st(t).whr).ttl)
3035. COLOR 15
3036. ce 13, "is yours."
3037. p
3038. EXIT SUB
3039. END IF
3040. IF lot(st(t).whr).hk THEN
3041. COLOR lot(st(t).whr).hue
3042. ce 12, RTRIM$(lot(st(t).whr).ttl)
3043. COLOR 15
3044. ce 13, "is mortgaged."
3045. p
3046. EXIT SUB
3047. END IF
3048. crl = di(d1, d2)
3049. ce 11, lts(d1) + " + " + lts(d2) + " = " + lts(crl) + ", $" + lts(10 * crl) + " due."
3050. p
3051. popp t, 10 * crl
3052. END SUB
3053.  
3054. SUB vwd
3055. DO
3056. box
3057. LOCATE 5, 11
3058. tiny 1
3059. LOCATE 6, 11
3060. tiny 3
3061. LOCATE 7, 11
3062. tiny 5
3063. LOCATE 8, 11
3064. tiny 6
3065. LOCATE 9, 11
3066. tiny 8
3067. LOCATE 10, 11
3068. tiny 9
3069. LOCATE 5, 25
3070. tiny 11
3071. LOCATE 6, 25
3072. tiny 12
3073. LOCATE 7, 25
3074. tiny 13
3075. LOCATE 8, 25
3076. tiny 14
3077. LOCATE 9, 25
3078. tiny 15
3079. LOCATE 10, 25
3080. tiny 16
3081. LOCATE 11, 25
3082. tiny 18
3083. LOCATE 12, 25
3084. tiny 19
3085. LOCATE 5, 40
3086. tiny 21
3087. LOCATE 6, 40
3088. tiny 23
3089. LOCATE 7, 40
3090. tiny 24
3091. LOCATE 8, 40
3092. tiny 25
3093. LOCATE 9, 40
3094. tiny 26
3095. LOCATE 10, 40
3096. tiny 27
3097. LOCATE 11, 40
3098. tiny 28
3099. LOCATE 12, 40
3100. tiny 29
3101. LOCATE 5, 55
3102. tiny 31
3103. LOCATE 6, 55
3104. tiny 32
3105. LOCATE 7, 55
3106. tiny 34
3107. LOCATE 8, 55
3108. tiny 35
3109. LOCATE 9, 55
3110. tiny 37
3111. LOCATE 10, 55
3112. tiny 39
3113. ce 13, "choose a deed to view or 0 to continue"
3114. wt = ner(14, 39)
3115. IF wt = 0 THEN EXIT DO
3116. SELECT CASE lot(wt).sty
3117. CASE "b"
3118. box
3119. COLOR lot(wt).hue
3120. ce 5, RTRIM$(lot(wt).ttl)
3121. COLOR 7
3122. ce 6, "cost $" + lts(lot(wt).c)
3123. ce 7, "mortgage value $" + lts(lot(wt).c / 2)
3124. ce 8, "rent $" + lts(lot(wt).r)
3125. ce 9, "rent with one house $" + lts(lot(wt).r1)
3126. ce 10, "rent with two houses $" + lts(lot(wt).r2)
3127. ce 11, "rent with three houses $" + lts(lot(wt).r3)
3128. ce 12, "rent with four houses $" + lts(lot(wt).r4)
3129. ce 13, "rent with hotel $" + lts(lot(wt).rhot)
3130. ce 14, "houses cost $" + lts(lot(wt).bc) + " each"
3131. ce 15, "hotel costs $" + lts(lot(wt).bc) + " plus 4 houses"
3132. COLOR 15
3133. IF lot(wt).own = 0 THEN
3134. ce 16, "unowned"
3135. ELSE
3136. ce 16, "owned by " + RTRIM$(st(lot(wt).own).ft)
3137. IF lot(wt).hk THEN
3138. ce 17, "mortgaged, $" + lts(INT(.5 + lot(wt).c * uf!)) + " to unmortgage."
3139. ELSE
3140. SELECT CASE lot(wt).stat
3141. CASE 0
3142. ce 17, "with no buildings"
3143. CASE 1
3144. ce 17, "with one house"
3145. CASE 2
3146. ce 17, "with two houses"
3147. CASE 3
3148. ce 17, "with three houses"
3149. CASE 4
3150. ce 17, "with four houses"
3151. CASE 5
3152. ce 17, "with hotel"
3153. END SELECT
3154. END IF
3155. END IF
3156. p
3157. CASE "u"
3158. box
3159. COLOR lot(wt).hue
3160. ce 5, RTRIM$(lot(wt).ttl)
3161. COLOR 15
3162. ce 6, "cost $150"
3163. ce 7, "mortgage value $75"
3164. ce 8, "rent with one Utility, four times dice"
3165. ce 9, "rent with two Utilities, ten times dice"
3166. IF lot(wt).own = 0 THEN
3167. ce 16, "unowned"
3168. ELSE
3169. ce 16, "owned by " + RTRIM$(st(lot(wt).own).ft)
3170. IF lot(wt).hk THEN ce 17, "mortgaged, $" + lts(INT(.5 + lot(wt).c * uf!)) + " to unmortgage."
3171. SELECT CASE lot(wt).stat
3172. CASE 1
3173. ce 18, "one Utility"
3174. CASE 2
3175. ce 18, "two utlities"
3176. END SELECT
3177. END IF
3178. p
3179. CASE "r"
3180. box
3181. COLOR lot(wt).hue
3182. ce 5, RTRIM$(lot(wt).ttl)
3183. COLOR 15
3184. ce 6, "cost $200"
3185. ce 7, "mortgage value $100"
3186. ce 8, "rent with one Railroad $25"
3187. ce 9, "rent with two Railroads $50"
3188. ce 10, "rent with three Railroads $100"
3189. ce 11, "rent with four Railroads $200"
3190. IF lot(wt).own = 0 THEN
3191. ce 16, "unowned"
3192. ELSE
3193. ce 16, "owned by " + RTRIM$(st(lot(wt).own).ft)
3194. IF lot(wt).hk THEN ce 17, "mortgaged, $" + lts(INT(.5 + lot(wt).c * uf!)) + " to unmortgage."
3195. SELECT CASE lot(wt).stat
3196. CASE 1
3197. ce 18, "one Railroad"
3198. CASE 2
3199. ce 18, "two Railroads"
3200. CASE 3
3201. ce 18, "three Railroads"
3202. CASE 4
3203. ce 18, "four Railroads"
3204. END SELECT
3205. END IF
3206. p
3207. CASE "o"
3208. IF (NOT q) THEN b
3209. END SELECT
3210. LOOP UNTIL wt = 0
3211. END SUB
3212.  
3213.  

I apologise with all QB64 coders not mentioned here, I preferred to use code taken from sample folder of QB64.
Hey I must apologise also with curator of the QB64 website! I have posted a code more than 1000 lines and you can find fun that linecode's number restarts from 1 after 1000!
Thanks to read

ciao @TempodiBasic

si ho visto esempi della calcolatrice se usi il goto dal alto verso il basso il codice è piu leggibile come ha fatto notare  SMcNeill
effettivamente a ragione
pero usando la tecnica strutturata è ancora meglio come nell esempio della seconda calcolatrice
poi i programmi di  CREATIVE COMPUTING MORRISTOWN, NEW JERSEY sono illeggibili
ed a ragione bplus  che dice che usano troppi goto perche non avevano altro
magari adesso la programmazione si è evoluta è in questi tempi usano tutti la programmazione strutturata
e anche consigliato mettere i commenti nel codice anche questo passaggio non veniva applicato i programmatori del passato
almeno da come mi sono documentato io ho capito questo poi può darsi che mi sbaglio ma sono qui per imparare e giusto che
se non è cosi qualcuno mi corregge

[Kernelpanic]

@Kiara - Ce ne può essere solo uno! Kiara, comprati per un libro per QBasic e "Code Complete" in italiano. Davvero! :-;

https://www.youtube.com/watch?v=XfjJzL6yWfU

[Kiara87]

@Kiara - Ce ne può essere solo uno! Kiara, comprati per un libro per QBasic e "Code Complete" in italiano. Davvero! :-;

https://www.youtube.com/watch?v=XfjJzL6yWfU

beautiful song i didn't think she was so famous