-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMufopoly.m
4207 lines (3763 loc) · 146 KB
/
Mufopoly.m
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
( MUFopoly MUF by Tursi - Gfx by Marjan )
( Written for FlipSide Muck )
( This program may be used on other mucks so long no credits are altered or removed )
( This program must be set at least M3. After compiling the program and setting it )
( W or M3, create a room for the game to run in - game data and commands are stored )
( in the room. )
( In the new room, run the program with the argument '#install' to set it up. You )
( must own the program to run #install. At that point, the game is ready to run. )
( A Wiz bit is preferred, however, the game *should* run at most mucks with an M3. )
( Be warned that with less than an M3 the game may not run reliably on all mucks: )
( -Instruction count per command can be very high )
( -'new' command calls NEXTPROP to remove obsolete games, requires M3 on some mucks )
( 'trading' also uses it to enumerate stored and pending trades )
( -Program 'CALL's itself to provide recursive calls for Chance and Comm. Chest )
( If they are broken, make sure it's set Linkable and the program has sufficient )
( permission for call )
( -Default storage prop is actually a Wiz prop using ~ so players can not cheat! )
( You WILL need to change this to run with M3 )
( -It's acceptable to set up multiple rooms on the same program. )
( You can have custom board sets - Just create a string with 40 space-separated )
( strings, and set it on the room as 'Setx', where x>0. Start a game as 'New x' to )
( use a custom set. Name the sets with the prop 'Namex' )
( )
( The following bugs/features are known: )
( -There are no Auctions )
( -You can not identify game by player who started it, only by number )
( -You can not identify squares by name prefix, only by number )
( -There is no 10% bank fee when trading mortgaged properties )
( -Free Parking always collects money )
( -Even property development across a group is not enforced )
( -After mortgaging a property, you may buy houses on other properties in the same group )
( -Retiring returns your properties to the bank, not to the player who bankrupted you )
( -- Standard Notice -- )
( Copyright 2011 Mike Brent aka Tursi aka HarmlessLion.com )
( This software is provided AS-IS. No warranty )
( express or implied is provided. )
( )
( This notice defines the entire license for this code. )
( All rights not explicity granted here are reserved by the )
( author. )
( )
( You may redistribute this software provided the original )
( archive is UNCHANGED and a link back to my web page, )
( http://harmlesslion.com, is provided as the author's site. )
( It is acceptable to link directly to a subpage at harmlesslion.com)
( provided that page offers a URL for that purpose )
( )
( Source code, if available, is provided for educational purposes )
( only. You are welcome to read it, learn from it, mock )
( it, and hack it up - for your own use only. )
( )
( Please contact me before distributing derived works or )
( ports so that we may work out terms. I don't mind people )
( using my code but it's been outright stolen before. In all )
( cases the code must maintain credit to the original author<s>. )
( )
( Addendum to the above paragraph for MUF code: )
( You may modify the software as required to port it to your own )
( system and offer the functionality publically, including sharing )
( the source with owners of similar systems, provided no functional )
( changes are made. You may not offer the modified software for )
( download, place on CD, or distribute by any automated or )
( commercial means without approval from the author. )
( )
( You may further modify the code for use on your own system and )
( make the resultant functionality available to users of your )
( system, however, you are requested not to distribute the modified )
( version at all. You are encouraged to submit your changes to the )
( author for incorporation into the official version, where )
( appropriate. )
( )
( -COMMERCIAL USE- Contact me first. I didn't make )
( any money off it - why should you? ;> If you just learned )
( something from this, then go ahead. If you just pinched )
( a routine or two, let me know, I'll probably just ask )
( for credit. If you want to derive a commercial tool )
( or use large portions, we need to talk. ;> )
( )
( Addendum to the above paragraph for MUF code: )
( This software's functionality may be offered publically on a )
( commercial server provided that no additional charge is made to )
( use it, and no modifications beyond that necessary to port the )
( software are made. The author would like to be notified of any )
( commercial server using his software and be offered an opportunity)
( to verify the installation. )
( )
( If this, itself, is a derived work from someone else's code, )
( then their original copyrights and licenses are left intact )
( and in full force. )
( )
( http://harmlesslion.com - visit the web page for contact info )
$include $lib/reflist
( Uncomment this to use lib/ansi codes instead of glowmuck codes. )
( It's a hacky compatibility layer, so slightly slower, but it works )
( $def USE_LIB_ANSI )
( Generic muck interface stuff )
( prop to store player-related game info on - player should not be able to alter it )
( to avoid cheating - note that a wizprop will cause the game to require a wizbit )
$def PLAYERPROP "/~Games/MUFopoly/"
( Object global game info is stored on)
$def GLOBALOBJECT loc @
( Prefix to all strings output by the game )
$def GAMEPREFIX "[] "
( --- Normally you don't need to change below this... -- )
( game defaults )
$def STARTCASH 1500
$def STARTHOUSES 32
$def STARTHOTELS 12
$def STARTPARKING 500
( there are forty spaces on the board - this defines information about each )
( Types: a=property b=comm.chest c=income tax d=railroad e=chance f=jail g=utility )
( h=free parking i=go to jail j=luxury tax k=go )
$def TYPES "K A B A C D A E A A F A G A A D A B A A H A E A A D A A G A I A A B A D E A J A"
( names of the spaces )
( Use '_' to indicate a line break space - first one only counts )
( Use '~' to indicate a space that must not break lines )
( 'Ave' becomes 'Avenue' on mortgage side automatically )
( Note: the '~&' in here are safe because the tildes are stripped before printing )
$define SPACES "Set" GetGameVal dup 0 = if
pop "GO Mediterranean_Ave Community_Chest Baltic_Ave Income_Tax Reading_Railroad Oriental_Ave Chance Vermont_Ave Connecticut_Ave Jail_(Just~Visiting) St.~Charles_Place Electric_Company States_Ave Virginia_Ave Pennsylvania_Railroad St.~James_Place Community_Chest Tennessee_Ave New~York_Ave Free_Parking Kentucky_Ave Chance Indiana_Ave Illinois_Ave B~&~O_Railroad Atlantic_Ave Ventnor_Ave Water_Works Marvin_Gardens Go~to_Jail Pacific_Ave North~Carolina_Ave Community_Chest Pennsylvania_Ave Short_Line Chance Park_Place Luxury_Tax Boardwalk_"
else
intostr "Set" swap strcat loc @ swap GetPropStr
then
$enddef
( Basic property - all prices are 4 digits for convenience, not necessity )
( Rent with 0 houses )
$def RENT0 "x 0002 x 0004 x x 0006 x 0006 0008 x 0010 x 0010 0012 x 0014 x 0014 0016 x 0018 x 0018 0020 x 0022 0022 x 0024 x 0026 0026 x 0028 x x 0035 x 0050"
( Rent with 1 house )
$def RENT1 "x 0010 x 0020 x x 0030 x 0030 0040 x 0050 x 0050 0060 x 0070 x 0070 0080 x 0090 x 0090 0100 x 0110 0110 x 0120 x 0130 0130 x 0150 x x 0175 x 0200"
( Rent with 2 houses )
$def RENT2 "x 0030 x 0060 x x 0090 x 0090 0100 x 0150 x 0150 0180 x 0200 x 0200 0220 x 0250 x 0250 0300 x 0330 0330 x 0360 x 0390 0390 x 0450 x x 0500 x 0600"
( Rent with 3 houses )
$def RENT3 "x 0090 x 0180 x x 0270 x 0270 0300 x 0450 x 0450 0500 x 0550 x 0550 0600 x 0700 x 0700 0750 x 0800 0800 x 0850 x 0900 0900 x 1000 x x 1100 x 1400"
( Rent with 4 houses )
$def RENT4 "x 0160 x 0320 x x 0400 x 0400 0450 x 0625 x 0625 0700 x 0750 x 0750 0800 x 0875 x 0875 0925 x 0975 0975 x 1025 x 1100 1100 x 1200 x x 1300 x 1700"
( Rent with Hotel )
$def RENTH "x 0250 x 0450 x x 0550 x 0550 0600 x 0750 x 0750 0900 x 0950 x 0950 1000 x 1050 x 1050 1100 x 1150 1150 x 1200 x 1275 1275 x 1400 x x 1500 x 2000"
( All property - includes railroads and utilities )
( Mortgage value )
$def MORTGAGE "x 0030 x 0030 x 0100 0050 x 0050 0060 x 0070 0075 0070 0080 0100 0090 x 0090 0100 x 0110 x 0110 0120 0100 0130 0130 0075 0140 x 0150 0150 x 0160 0100 x 0175 x 0200"
( Purchase price )
$def PURCHASE "x 0060 x 0060 x 0200 0100 x 0100 0120 x 0140 0150 0140 0160 0200 0180 x 0180 0200 x 0220 x 0220 0240 0200 0260 0260 0150 0280 x 0300 0300 x 0320 0200 x 0350 x 0400"
( Group information )
( Each square - group number from 0-9, railroad is 1, utility is 4 )
$def GROUPS "x 0 x 0 x 1 2 x 2 2 x 3 4 3 3 1 5 x 5 5 x 6 x 6 6 1 7 7 4 7 x 8 8 x 8 1 x 9 x 9"
( See the dojoin function which hard-codes the number of elements in each group )
( House prices are indexed by group number )
$def HOUSE "050 000 050 100 000 100 150 150 200 200"
( Square color by group number )
$def COLORS "^violet^ ^normal^ ^cyan^ ^purple^ ^normal^ ^brown^ ^red^ ^yellow^ ^green^ ^blue^"
( ------------------- )
( Data structures )
( Player: ~Games/MUFopoly/ )
( PlayingIn: <game number> )
( Location: <square number> )
( InJail: <0, or number of turns so far> )
( JailFree: <number of 'get out of jail free' cards> )
( Groups/0-9:<number of properties not owned in this group> )
( Property/1-40: 0=not owned )
( 1-5=0-4 houses )
( 6=hotel )
( 7=mortgaged )
( Cash: <amount> )
( Wins: <number of wins> )
( Losses: <number of losses> )
( Aborts: <number of times dropped out> )
( Trades/<player number>/Offer:<str> )
( Wanted:<str> )
( <str> is $cash or properties list )
( )
( Trigger or Room: ~Games/MUFopoloy/ )
( NextGame: # )
( <game#>/)
( Players: <proplist> )
( Watchers: <proplist> )
( Started: 0 if not started yet, else 1 )
( Turn: <player #> )
( FreeParking: <amount> )
( Phase: 1-roll, 2-buy, 3-get out of debt )
( DoublesCount: 0-3 )
( LastTurn: <timestamp> )
( Property/1-40: <player # of owner, or 0> )
( HousesLeft: <count> )
( HotelsLeft: <count> )
( )
( Wizard Commands )
( #install: creates the actions in the room to run the game )
( )
( I finally had to use a FEW variables to simplify the code... )
var ThisRoll
var ForceNextTurn
var TmpStr
var TmpDebug
var TmpDebug2
var TmpDebug3
var LocalTmp
var LocalTmp2
var LocalTmp3
var RentPenalty
( ------------------- )
$ifdef USE_LIB_ANSI
$include $lib/ansi
( add any other ansi functions used here )
$def ansistrip ansifix ansi_strip
$def notify ansifix ansi_notify
( convert glow style codes to lib-ansi )
: ansifix ( s -- s )
( because this code doesn't use the background colors, we don't include them for speed's sake )
"~&000" "^black^" subst
"~&010" "^crimson^" subst
"~&020" "^forest^" subst
"~&030" "^brown^" subst
"~&040" "^navy^" subst
"~&050" "^violet^" subst
"~&060" "^aqua^" subst
"~&070" "^gray^" subst
"~&100" "^gloom^" subst
"~&110" "^red^" subst
"~&120" "^green^" subst
"~&130" "^yellow^" subst
"~&140" "^blue^" subst
"~&150" "^purple^" subst
"~&160" "^cyan^" subst
"~&170" "^white^" subst
"~&R" "^normal^" subst
;
$else
( Ignore ansifix and fixup ansi_strip )
( I don't know if ansi_strip actually exists at glow mucks? Do you need to strip out ANSI codes? )
$def ansifix
$def ansistrip ansi_strip
$endif
( Compatibility STRcenter, STRleft and STRright that ignore ANSI and truncate as well as pad )
( Bug: truncation is incorrect if the color tags are in the trimmed area! )
( For center, that's at either end, for left it's at the end, for right it's at the beginning )
: STRcenter ( str width -- str )
dup -3 rotate
over ansistrip strlen over over < if
( string is too long, trim it )
swap - 1 + 2 / begin dup while
swap
1 strcut swap pop
dup strlen 1 - strcut pop
swap
1 -
repeat
else
( string is too short, pad it )
- 1 + 2 / begin dup while
swap
" " swap strcat " " strcat
swap
1 -
repeat
then
pop
dup ansistrip strlen rot > if 1 strcut swap pop then
;
: STRleft ( str width -- str )
over ansistrip strlen over over < if (
( string is too long, trim it )
swap -
over strlen swap -
strcut pop
else
( string is too short, pad it )
- begin dup while
swap
" " strcat
swap
1 -
repeat
pop
then
;
: STRright ( str width -- str )
over ansistrip strlen over over < if
( string is too long, trim it )
swap - strcut swap pop
else
( string is too short, pad it )
- begin dup while
swap
" " swap strcat
swap
1 -
repeat
pop
then
;
( Get the game number from the player )
: GetGame ( -- s )
me @ PLAYERPROP "PlayingIn" strcat getpropstr
;
( Turn a string into a player prop string and dbref )
: MakePlayerProp ( p# s -- # s)
PLAYERPROP swap strcat
;
( Get a prop string from the player )
: GetPlayerStr ( p# s -- s )
over #0 dbcmp if pop pop "" exit then
MakePlayerProp getpropstr
;
( Get a value from the player )
: GetPlayerVal ( p# s -- n )
over #0 dbcmp if pop pop 0 exit then
MakePlayerProp getpropval
;
( Turn a string into a game prop string and dbref for the current player's game )
: MakeGameProp ( s -- # s )
GetGame PLAYERPROP swap strcat "/" strcat swap strcat
GLOBALOBJECT swap
;
( Get a string from the game )
: GetGameStr ( s -- s )
MakeGameProp getpropstr
;
( Get a value from the game )
: GetGameVal ( s -- n )
MakeGameProp getpropval
;
( Get a specific game prop )
: MakeGameNProp ( s s -- # s )
PLAYERPROP rot strcat "/" strcat swap strcat
GLOBALOBJECT swap
;
( Get a specific game string )
: GetGameNStr ( s s -- s )
MakeGameNProp getpropstr
;
( Get a specific game value )
: GetGameNVal ( s s -- n )
MakeGameNProp getpropval
;
( Send a message to the requested player )
: TellOne ( # s -- )
GAMEPREFIX swap strcat notify
;
( Send a message to current player )
: TellMe ( s -- )
me @ swap TellOne
;
( pre-emptively acquire a run lock on the game )
( will block until the game is available )
( no action if you are not in a game )
( should it timeout?? )
: lockgame ( -- )
( no lock required if not in a game )
me @ "PlayingIn" GetPlayerStr "" strcmp if
1 begin dup while
( disable multitasking - only one script in this at a time )
preempt
( try to get the game lock variable )
"GameLock" GetGameVal 0 = if
(we got it, set the value and we are done)
"GameLock" MakeGameProp "" 1 addprop
pop 0
else
1 +
dup 500000 > if
(it has been too long)
"** Removing stale lock - continuing..." tellme
break
then
then
( give other script a chance to run )
foreground
repeat
pop
then
;
( release the game run lock - no action if you )
( are not in a game )
: unlockgame ( -- )
( no lock required if not in a game )
me @ "PlayingIn" GetPlayerStr "" strcmp if
preempt
"GameLock" MakeGameProp "" 0 addprop
foreground
then
;
( ------------------- )
( Used for the Chance and Comm Chest, don't change this )
$def JAILFREECARD "G"
( Extract a numbered value from a list - 1-based )
( Note: debug is spammy as hell and disabled in this function )
: GetVal ( s n -- s )
( disable debug )
prog "D" flag? tmpdebug !
prog "!D" set
( --- )
dup 0 > not if
pop pop ""
( re-enable debug )
tmpdebug @ if
prog "D" set
then
( --- )
exit
then
tmpstr !
" " explode
dup tmpstr @ < if
begin dup while swap pop 1 - repeat pop ""
( re-enable debug )
tmpdebug @ if
prog "D" set
then
( --- )
exit
then
tmpstr @ 1 + pick tmpstr !
begin dup while swap pop 1 - repeat pop
tmpstr @
( re-enable debug )
tmpdebug @ if
prog "D" set
then
( --- )
;
( Retrieve the name of a square - does not parse '~' )
: GetName ( n -- s )
SPACES swap GetVal
" " "_" subst ( _ becomes a real space )
;
( Retrieve the full name of a square )
: GetFullName ( n -- s )
GetName
" " "~" subst ( ~ becomes real space )
;
( Retrieve the first name of a square )
: GetFirstName ( n -- s )
GetName
dup " " instr dup if 1 - strcut pop else pop then
" " "~" subst ( ~ becomes real space )
;
( Retrieve the last name of a square )
: GetLastName ( n -- s )
GetName
dup " " instr dup if strcut swap pop else pop pop "" then
" " "~" subst ( ~ becomes real space )
;
( Retrieves the group number for a property )
: GetGroup ( n -- s )
GROUPS swap GetVal
;
( Retrieves the color string for a property )
: GetColor ( n -- s )
GetGroup dup "x" strcmp not if pop "^normal^" exit then
atoi 1 + COLORS swap GetVal
;
( Retrieve the type of square - return free parking 'H' when invalid )
: GetType ( n -- s )
TYPES swap GetVal dup "" strcmp not if pop "H" exit then
;
( Retrieves the rent0 for a property )
: GetRent0 ( n -- n )
RENT0 swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the rent1 for a property )
: GetRent1 ( n -- n )
RENT1 swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the rent2 for a property )
: GetRent2 ( n -- n )
RENT2 swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the rent3 for a property )
: GetRent3 ( n -- n )
RENT3 swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the rent4 for a property )
: GetRent4 ( n -- n )
RENT4 swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the rent hotel for a property )
: GetRentH ( n -- n )
RENTH swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the mortgage value for a property )
: GetMort ( n -- n )
MORTGAGE swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Retrieves the housing cost for a property )
: GetHouse ( n -- s )
GetGroup dup "x" strcmp not if pop 0 exit then
atoi 1 + HOUSE swap GetVal atoi
;
( Retrieves the purchase cost for a property )
: GetPrice ( n -- n )
PURCHASE swap GetVal dup "x" strcmp not if pop 0 exit then
atoi
;
( Update the game's access timestamp - game number as a string )
: UpdateTimestamp ( s -- )
GLOBALOBJECT PLAYERPROP rot strcat "/LastTurn" strcat "" systime addprop
;
( Get the owner of a property )
: GetOwner ( n -- dbref )
intostr "Property/" swap strcat GetGameVal dbref
;
( Get number of houses - or hotel, or mortgage - on a property )
: GetHouseCount ( n -- n )
dup GetOwner
swap "Property/" swap intostr strcat GetPlayerVal
1 -
;
( Send a string to all players and watchers: )
( - Ensure they are connected )
( - Remove from the list watchers who disconnect or leave the room )
: tellplayers ( s -- )
( First tell the game players )
"Players" MakeGameProp
REF-allrefs
begin dup while
dup 2 + pick rot swap tellone
1 -
repeat
pop
( Now tell the watchers. Any watcher who is asleep or in another room will be removed )
( They are also removed if they are playing a game! )
"Watchers" MakeGameProp
REF-allrefs
begin dup while
over dup dup awake? swap location loc @ dbcmp and not swap "PlayingIn" GetPlayerStr "" strcmp or if
( remove this watcher )
swap "Watchers" MakeGameProp rot REF-delete
else
( tell this watcher )
dup 2 + pick rot swap tellone
then
1 -
repeat
pop
pop
;
( Add money to Free Parking )
: AddFreeParking ( amount )
"FreeParking" GetGameVal swap +
"FreeParking" MakeGameProp "" 4 rotate addprop
;
( Set up props for 'me' being in jail )
: GoToJail ( -- )
me @ "InJail" MakePlayerProp "" 1 addprop
me @ "Location" MakePlayerProp "" 11 addprop
( Doubles stop counting when you go to jail )
"DoublesCount" MakeGameProp "" 0 addprop
;
( Get the actual rent on a property - NOTE: Not Utility or Railroad )
( Also note: Must be owned! )
: GetActualRent ( n -- n )
dup GetHouseCount ( n c )
dup 0 = if ( n c )
pop dup GetRent0 ( n r0 )
over GetGroup ( n r0 gr )
"Groups/" swap strcat rot GetOwner swap GetPlayerVal
0 = if
"- All properties in group are owned - rent is doubled!" tellplayers
2 *
then
else
dup 1 = if pop GetRent1 else
dup 2 = if pop GetRent2 else
dup 3 = if pop GetRent3 else
dup 4 = if pop GetRent4 else
dup 5 = if pop GetRentH else
pop pop 0 exit
then
then
then
then
then
then
;
( Get the actual rent on a Railroad only )
: GetRailroadRent ( n -- n )
( Check unowned or mortgaged )
dup GetHouseCount dup -1 = swap 6 = or if pop 0 exit then
( Railroads are group 1, and there are 4, so we use that stat )
GetOwner dup "Groups/1" GetPlayerVal
( Check any are owned )
dup dup 0 < swap 3 > or if pop 0 exit then
( If a penalty is set, it is twice the regular rent )
dup 0 = if pop name " owns all four railroads! Rent is $" strcat 200 then
dup 1 = if pop name " owns three railroads. Rent is $" strcat 100 then
dup 2 = if pop name " owns two railroads. Rent is $" strcat 50 then
dup 3 = if pop name " owns only one railroad. Rent is $" strcat 25 then
( Had to be one of the above, so the value is now popped )
RentPenalty @ if 2 * then
swap over intostr strcat "." strcat tellplayers
;
( Get the actual rent on a Utility )
: GetUtilityRent ( n -- n )
( Check unowned or mortgaged )
dup GetHouseCount dup -1 = swap 6 = or if pop 0 exit then
( If a penalty is set, it is a new roll, and 10 times the amount thrown )
RentPenalty @ if ( not necessary to reset because it's only valid for one command )
pop
( roll two dice )
random 6 % 1 +
random 6 % 1 +
me @ name " rolls " strcat over intostr strcat " and " strcat 3 pick intostr strcat "." strcat tellplayers
+ 10 *
exit
then
( Utilities are group 4, and there are 2 of them )
GetOwner dup "Groups/4" GetPlayerVal
dup 0 = if pop name " owns both utilities - rent is 10 times roll!" strcat tellplayers thisroll @ 10 * exit then
dup 1 = if pop name " owns one utility, rent is 4 times roll." strcat tellplayers thisroll @ 4 * exit then
pop pop 0
;
( Gets a player's current worth and stats )
: GetWorth ( player# - Properties Mortgages Groups Houses Hotels Cash Total )
( disable debug )
prog "D" flag? tmpdebug3 !
prog "!D" set
( --- )
0 0 0 0 0 0 0
( Properties )
1 begin ( # P M G H H C T n )
"Property/" over intostr strcat
10 pick swap GetPlayerVal
dup 0 = not if
( Property is owned )
over GetPrice ( # P M G H H C T n h $ )
over 7 = if 2 / then ( mortgaged property = 1/2 value )
4 rotate + -3 rotate ( # P M G H H C T n h )
9 rotate 1 + -9 rotate ( # P M G H H C T n h )
dup 7 = if
( Property is mortgaged )
8 rotate 1 + -8 rotate
else
dup 6 = if
( Property has a hotel )
over GetHouse 5 * 4 rotate + -3 rotate
5 rotate 1 + -5 rotate
else
( Property may have houses )
1 -
dup 7 rotate + -6 rotate
dup 3 pick GetHouse * 4 rotate + -3 rotate
then
then
then
pop
1 + dup 41 < while
repeat
pop
( Groups - stat only )
0 begin ( # P M G H H C T n )
"Groups/" over intostr strcat
10 pick swap GetPlayerVal
0 = if ( # P M G H H C T n )
6 rotate 1 + -6 rotate
then
1 + dup 10 < while
repeat
pop
( Cash )
"Cash" 9 pick swap GetPlayerVal ( # P M G H H C T $ )
dup 4 rotate + -3 rotate
+ ( # P M G H H C T )
8 rotate pop ( P M G H H C T )
( re-enable debug )
tmpdebug3 @ if
prog "D" set
then
( --- )
;
( Remove a prop - wrapper for remove_prop that ignores the / at the end )
: propremove ( # s -- )
dup strlen 1 - strcut
dup "/" strcmp not if
pop
else
strcat
then
remove_prop
;
( Return a string with spaces between each character )
: spaceit ( s -- s )
dup strlen ( s l )
begin 1 - dup while ( s l )
dup -3 rotate strcut " " swap strcat
strcat
swap
repeat
pop
;
( Draw bottom line to show who owns a square, if anyone )
: ShowSquareInfo ( n -- )
me @ "PlayingIn" GetPlayerStr "" strcmp not if
( Not playing a game, just draw an emtpy base )
pop "^white^|_____________________________|" tellme
exit
then
GetOwner dup #0 dbcmp if
( Not owned, just draw an emtpy base )
pop
"^white^|_____________________________|" tellme
exit
then
name "^normal^Owned by: ^yellow^" swap strcat "^white^" strcat 29 STRcenter
"_" " " subst "|" strcat "^white^|" swap strcat tellme
;
( Print out a deed for a square )
: PrintADeed ( n -- )
TYPES over GetVal dup "" strcmp not if
"* Square out of range" tellme pop pop exit
then
over GetHouseCount
dup 6 = if
( property is mortgaged )
pop pop
"^white^_______________________________" tellme
"^white^| |" tellme
"^white^|" over GetFirstName toupper 29 STRcenter strcat "^white^|" strcat tellme
"^white^|" over GetLastName dup "Ave" stringcmp not if pop "Avenue" then 29 STRcenter strcat "^white^|" strcat tellme
"^white^| |" tellme
"^white^| - |" tellme
"^white^| |" tellme
"^white^| MORTGAGED |" tellme
"^white^| FOR $" over GetMort intostr 3 STRLeft strcat " |" strcat tellme
"^white^| |" tellme
"^white^| - |" tellme
"^white^| |" tellme
"^white^| Card must be turned this |" tellme
"^white^| side up if property is |" tellme
"^white^| mortgaged. |" tellme
"^white^| |" tellme
"^white^| |" tellme
ShowSquareInfo
exit
then
-3 rotate ( housecount square type )
dup "A" strcmp not if
( property )
pop
"^white^_______________________________" tellme
"^white^|" over getcolor strcat "###########################" strcat over 10 < if "#" strcat then "^normal^" strcat over intostr strcat "^white^|" strcat tellme
"^white^|" over getcolor strcat "###( ^white^" strcat over GetFullName 20 STRcenter strcat over getcolor strcat ")###^white^|" strcat tellme
"^white^|" over getcolor strcat "#############################^white^|" strcat tellme
"^white^|\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"|" tellme
dup GetGroup "Groups/" swap strcat over getowner dup rot GetPlayerVal
swap #0 dbcmp not swap 0 = and 3 pick 1 < and if
"^white^|" 3 pick 0 = if "^green^" strcat then " RENT" strcat over GetRent0 2 * intostr "$" swap strcat 4 STRright strcat ". ^white^|" strcat tellme
"^white^|^green^(double rent for color group)^white^|" tellme
else
"^white^|" 3 pick 0 = if "^green^" strcat then " RENT" strcat over GetRent0 intostr "$" swap strcat 4 STRright strcat ". ^white^|" strcat tellme
"^white^| |" tellme
then
"^white^|" 3 pick 1 = if "^green^" strcat then " With 1 House $" strcat over GetRent1 intostr 4 STRright strcat ". ^white^|" strcat tellme
"^white^|" 3 pick 2 = if "^green^" strcat then " With 2 Houses $" strcat over GetRent2 intostr 4 STRright strcat ". ^white^|" strcat tellme
"^white^|" 3 pick 3 = if "^green^" strcat then " With 3 Houses $" strcat over GetRent3 intostr 4 STRright strcat ". ^white^|" strcat tellme
"^white^|" 3 pick 4 = if "^green^" strcat then " With 4 Houses $" strcat over GetRent4 intostr 4 STRright strcat ". ^white^|" strcat tellme
"^white^|" 3 pick 5 = if "^green^" strcat then " With HOTEL" strcat over GetRentH intostr "$" swap strcat 6 STRright strcat ". ^white^|" strcat tellme
"^white^| |" tellme
"^white^| Mortgage Value" over GetMort intostr "$" swap strcat 5 STRright strcat ". |" strcat tellme
"^white^| Houses cost" over GetHouse intostr "$" swap strcat 5 STRright strcat ". each |" strcat tellme
"^white^| Hotels," over GetHouse intostr "$" swap strcat 5 STRright strcat ". plus 4 houses |" strcat tellme
"^white^| |" tellme
swap pop
ShowSquareInfo
exit
then
dup "D" strcmp not if
( railroad )
pop
( We actually want the railroad owned count )
over -1 = 3 pick 6 = or if 4
else
( property is owned, get the count )
( Railroads are group 1, and there are 4, so we use that stat )
dup GetOwner "Groups/1" GetPlayerVal
( 4, 3, 2, 1, or 0 )
then
( HOUSCNT, SQ, OWNCNT )
swap ( HOUSCNT, OWNCNT, SQ )
"^white^_______________________________" tellme
"^white^|###########\"\"###\"\"\"\"#######" over 10 < if "#" strcat then "^normal^" strcat over intostr strcat "^white^|" strcat tellme
"^white^|###########\\/###\\ /#########|" tellme
"^white^|#########( (##########|" tellme
"^white^|#########/_/(_)#(_)##########|" tellme
"^white^| --------------------------- |" tellme
"^white^|" over GetFullName 29 STRcenter strcat "|" strcat tellme
"^white^| --------------------------- |" tellme
"^white^| |" tellme
"^white^|" 3 pick 3 = if "^green^" strcat then " Rent $25. ^white^|" strcat tellme
"^white^|" 3 pick 2 = if "^green^" strcat then " If 2 R.R.'s are owned 50. ^white^|" strcat tellme
"^white^|" 3 pick 1 = if "^green^" strcat then " If 3 \" \" \" 100. ^white^|" strcat tellme
"^white^|" 3 pick 0 = if "^green^" strcat then " If 4 \" \" \" 200. ^white^|" strcat tellme
"^white^| |" tellme
"^white^| Mortgage Value $100. |" tellme
"^white^| |" tellme
"^white^| |" tellme
ShowSquareInfo
pop pop
exit
then
dup "G" strcmp not if
( utility )
pop
( We actually want the utility owned count )
over -1 = 3 pick 6 = or if 2
else
( property is owned, get the count )
( Utilities are group 4, and there are 2, so we use that stat )
dup GetOwner "Groups/4" GetPlayerVal
( 1, or 0 )
then
swap
( only two utilties )
dup 20 < if
( Electric company )
"^white^_______________________________" tellme
"^white^| ,-, " over 10 < if " " strcat then "^normal^" strcat over intostr strcat "^white^|" strcat tellme
"^white^| | V | |" tellme
"^white^| \\|/ |" tellme
"^white^| W |" tellme
"^white^| --------------------------- |" tellme
"^white^|" over GetFullName 29 STRcenter strcat "|" strcat tellme
else
"^white^_______________________________" tellme
"^white^| " over 10 < if " " strcat then "^normal^" strcat over intostr strcat "^white^|" strcat tellme
"^white^| \"X\" |" tellme
"^white^| (xxHxo, |" tellme
"^white^| \" |" tellme
"^white^| --------------------------- |" tellme
"^white^|" over GetFullName 29 STRcenter strcat "|" strcat tellme
then
"^white^| --------------------------- |" tellme
"^white^|" 3 pick 1 = if "^green^" strcat then " If one \"Utility\" is owned ^white^|" strcat tellme
"^white^|" 3 pick 1 = if "^green^" strcat then " rent is 4 times amount ^white^|" strcat tellme
"^white^|" 3 pick 1 = if "^green^" strcat then " shown on dice. ^white^|" strcat tellme
"^white^|" 3 pick 0 = if "^green^" strcat then " If both \"Utilities\" are ^white^|" strcat tellme
"^white^|" 3 pick 0 = if "^green^" strcat then " owned rent is 10 times ^white^|" strcat tellme
"^white^|" 3 pick 0 = if "^green^" strcat then " amount shown on dice. ^white^|" strcat tellme
"^white^| |" tellme
"^white^| Mortgage Value $75. |" tellme
"^white^| |" tellme
ShowSquareInfo
pop pop
exit
then
pop pop intostr "* Square was not recognized: " swap strcat tellme
;
( Appends a square to the strings for display )
: AddOneSquare ( 18 strings, top to bottom, # to add -- 18 strings)
dup 40 > if 40 - then
dup 1 < if 40 + then
TYPES over GetVal dup "" strcmp not if
pop pop exit
then
dup "A" strcmp not if ( 18 n A )
( property )
pop ( 18 n )
swap "^white^___________________" strcat -19 rotate
( Decide which top picture to draw )
dup getcolor TmpStr ! ( save color string )
dup GetHouseCount
dup 6 = if
pop ( mortgaged )
swap "^white^|" strcat TmpStr @ strcat "###############" strcat over 10 < if "#" strcat then "^normal^" strcat over intostr strcat "^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "####^white^MORTGAGED" strcat TmpStr @ strcat "####^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "#################^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "#################^white^|" strcat -19 rotate
else dup 5 = if
pop ( hotel )
swap "^white^|" strcat TmpStr @ strcat "####^crimson^___###___" strcat TmpStr @ strcat "##" strcat over 10 < if "#" strcat then "^normal^" strcat over intostr strcat "^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "###^crimson^/#########\\" strcat TmpStr @ strcat "###^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "###^crimson^|# #Y\"Y# #|" strcat TmpStr @ strcat "###^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "###^crimson^|###|_|###|" strcat TmpStr @ strcat "###^white^|" strcat -19 rotate
else dup 4 = if
pop
swap "^white^|" strcat TmpStr @ strcat "#^forest^,," strcat TmpStr @ strcat "##^forest^,," strcat TmpStr @ strcat "###^forest^,," strcat TmpStr @ strcat "##^forest^," strcat over 10 < if "," strcat then "^normal^" strcat over intostr strcat "^white^|" strcat -19 rotate
swap "^white^|" strcat TmpStr @ strcat "^forest^/##\\/##\\" strcat TmpStr @ strcat "#^forest^/##\\/##\\^white^|" strcat -19 rotate