-
Notifications
You must be signed in to change notification settings - Fork 12
/
Copy pathcmd-editplayer.muf
1409 lines (1285 loc) · 45.6 KB
/
cmd-editplayer.muf
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
(* hopemorph.muf
*
* Simplified editplayer / morpher as used for Hope Island MUCK.
*
* Prop-compatible with DescTools.muf in a limited fashion -- i.e. if you
* have DescTools props, they will be read and you can use this program.
* However, this program does not promise backwards compatibility. It is
* designed as a replacement for DescTools rather than a tool that coexists
* with it.
*
* This did impose some wonky design choices on the prop structure, but
* it works okay. It isn't optimal but it works well enough. And for
* the moment, DescTools morph and this one are actually interoperable
* if you run both of them, though that may not always be the case as the
* tool evolves.
*
* By HopeIslandCoder
* 2023
* Public Domain
*
**************************************************************************
* VERSION HISTORY
*
* v1.01 - 5/13/2023 - Bug fixes
* When you edit global looktraps, it will now re-apply
* your description [re-run morph].
* Looktrap editor is now also friendly to people who
* aren't using the morph program but want to use it to
* set looktraps [it preserves their _/de prop and does
* not do a 'full' morph]
*)
$def VERSION "Hope Morph v1.01 by HopeIslandCoder"
$version 1.01
$author HopeIslandCoder
(*
* Configuration - there's a few things that may vary from MUCK to MUCK.
*
* Let's start with HAND props. Natasha's hand command defaults to handable
* unless you specifically set yourself not-handable. Most hand
* implementations actually work in the opposite direction. These defs
* allow you to control how this works.
*)
$def IS_HAND_OK me @ "_hand/hand_ok" getpropstr strlen not
$def SET_HAND_OK me @ "_hand/hand_ok" remove_prop
$def SET_HAND_NOK me @ "_hand/hand_ok" "no" setprop
(*
* FLIGHT might vary from MUCK to MUCK. Some MUCKs might not even have
* this, so I guess it would make sense to disable the option altogether,
* but I'm writing this for Hope Island right now and so I will selfishly
* not care about others MUCKs for now. You're lucky you get this level
* of config :]
*)
$def IS_FLY_OK me @ "_fly?" getpropstr "yes" strcmp not
$def SET_FLY_OK me @ "_fly?" "yes" setprop
$def SET_FLY_NOK me @ "_fly?" remove_prop
(* Property for smell, touch, feel *)
$def SMELL_PROP "_prefs/smell"
$def FEEL_PROP "_prefs/feel"
$def TASTE_PROP "_prefs/taste"
(* What 'ride' messages do we support. If you add to this list, you will
* also need to edit 'which-ride-message'. If there's a demand for it,
* I will make 'which-ride-message' feed off this list... however I think
* probably all MUCKs use this same list.
*)
$def RIDE_MODES { "fly" "hand" "paw" "walk" "ride" }list
(* End configuration *)
$include $lib/editor
$include $lib/lmgr
$include $lib/tabtoolkit
(* We use this all over the place, make things a little easier *)
$def GLOBAL_ROOT "/_descs/prefs/global/"
(* WORKFLOW NOTES
*
* Purpose of this program is twofold; first, to provide a way for a user to
* edit their basic settings. Secondly, to allow morphing from description to
* description.
*
* Character Settings
* - Using color?
* - Which type of 'ride' carry?
* - Set default look traps
* - Set items on person lookat-able
* - Set hand okay
* - Set can fly
* - gender
* - species
* - disable look notify [enabled by default]
* - set default description on connect
* - set default description on disconnect
* - toggle notify description on connect
* - scent
* - feel
* - taste
*
* Descriptions
*
* - Add
* - List
* - Delete
* - Edit
* - Set current
*
* Descriptions have:
* - the descriptive text
* - per-description looktraps [override globals]
* - gender
* - species
* - message to yourself when changing
* - message to others when changing
* - scent
* - feel
* - taste
*
* comamnd shortcuts:
*
* No arguments: enters editor
* Argument: if #help, show help. Else, try to load description.
*
* Support: #list, #add, #edit, #delete, #status
*)
: help ( -- ) (* Display help banner *)
VERSION 70 tt-tab-init
"This is a program to set up your character and edit 'morphs'." tt-tab-addline
"Morphs are what MUCKs like to call description changes or"
tt-tab-addline
"different sets of clothes/outfits/etc." tt-tab-addline
"-[Usage]--------------------------------------------------------------"
tt-tab-addline
command @ 20 tt-shave-to-len "- Enter the editor" strcat tt-tab-addline
command @ " <Descr>" strcat 20 tt-shave-to-len "- Change to description"
strcat tt-tab-addline
command @ " #status" strcat 20 tt-shave-to-len
"- Current description information." strcat tt-tab-addline
command @ " #list" strcat 20 tt-shave-to-len "- List descriptions" strcat
tt-tab-addline
command @ " #add" strcat 20 tt-shave-to-len
"- Shortcut to add new description." strcat tt-tab-addline
command @ " #delete" strcat 20 tt-shave-to-len
"- Shortcut to delete description" strcat tt-tab-addline
command @ " #edit" strcat 20 tt-shave-to-len
"- Shortcut to edit description" strcat tt-tab-addline
"-[Special]------------------------------------------------------------"
tt-tab-addline
"If you use the q-version of a command, for instance 'qmorph', it"
tt-tab-addline
"will run silently and not display messages to the room. This is"
tt-tab-addline
"helpful if you show up somewhere in the wrong outfit and want to"
tt-tab-addline
"fix it without drawing attention, or possibly other RP purposes."
tt-tab-addline
"" tt-tab-final-flush
;
: cb-yes-no ( s -- i ) (* Callback for yes / no questions *)
strip tolower
dup "y" 1 strncmp not if
pop 1 exit
else "n" 1 strncmp not if
1 exit
then then
"Please answer 'y'es or 'n'o." tell 0
;
: cb-get-desc-name ( s -- i ) (* Callback for entering description name *)
dup ".abort" strcmp not if
pop 1 exit
then
dup ".list" strcmp not if
pop 1 exit
then
dup "prefs" strcmp not if
pop
"You can't have a description named 'prefs' because that is reserved."
tell 0 exit
then
"^[a-zA-Z0-9_-]+$" 0 regexp array_count swap array_count or dup
not if
"Description names must only be letters, numbers, and _ or -." tell
"You can use '.abort' to cancel the process." tell
then
;
: cb-get-any-string ( s -- i ) (* Callback for fetching any non-empty string *)
strip strlen dup not if
"Please enter some text."
then
;
: cb-get-prop-name ( s -- i ) (* Get a string that is valid for a prop name
* without tripping over a secure property that
* we shouldn't be reading/writing.
*)
(* This lil regex is down below in the editor as well, so if you change
* it here, change it there too.
*)
strip dup strlen not if
pop "Property name can't be empty." tell 0
else "[:/@~]" 0 regexp array_count swap array_count or if
"You can use most characters, but you can't use reserved property " tell
"characters, such as : / @ or ~" tell
0
else
1
then then
;
: cb-pick-ride-mode ( s -- i ) (* Callback for picking a ride mode *)
tolower dup ".abort" strcmp not if ( special case )
pop 1
else RIDE_MODES swap array_findval array_count dup not if
"Ride mode must be one of: " RIDE_MODES "," array_join strcat tell
then then
;
: input-loop ( s i a -- s' ) (* Takes a stackrange of strings that are some
* kind of question to ask, and a function which
* is a callback to check the validity of the
* answer. Loops until a valid answer is given
* then returns that valid answer.
*
* Callback should [ s -- i ] returning boolean
* Callbacks have to be defined above this
* function.
*)
var! callback array_make
begin
dup { me @ }list array_notify
read strip
dup callback @ execute if
swap pop
exit
then
pop
repeat
;
: which-ride-message ( -- s ) (* Looks at the RIDE/_mode prop and determines
* which kind of RIDE messages are being used
* by the player, returning them in human
* friendly form.
*)
me @ "RIDE/_mode" getpropstr tolower
dup dup strlen not swap "ride" strcmp not or if
pop "carrying riders"
else dup "fly" strcmp not if
pop "flying with"
else dup "hand" strcmp not if
pop "holding hands"
else dup "paw" strcmp not if
pop "holding paws"
else dup "walk" strcmp not if
pop "walking with"
else
pop "custom setup"
then then then then then
;
: which-morph ( -- s ) (* Which morph is currently set *)
me @ "_descs/prefs/current" getpropstr
dup strlen not if
pop "not using morph program"
then
;
: determine-list-name ( s -- s ) (* Given a string value, figure out if
* it has an MPI list in it {list:...} or
* not. If it does, return the list name.
* Otherwise, return empty ""
*
* I should probably put this in a library
* because I copy/pasted this code from
* my editroom :]
*)
dup "{list:" instring if
"{list:" split swap pop
"," split pop (* Might have a comma, might not *)
"}" split pop (* But will have a close-brace. *)
else
pop ""
then
;
: list-looktraps[ basepath -- ] (* Lists looktraps belonging to the given
* basepath [see modify-looktraps]
*)
basepath @ GLOBAL_ROOT strcmp not if
"> Note, this ONLY lists global looktraps!" tell
else
"> Note, this ONLY lists looktraps for the description you are working on!"
tell
then
me @ basepath @ nextprop
dup strlen not if
pop ".... And it looks like you have none set yet!" tell
else
begin
dup strlen while
dup "/" rsplit swap pop tell
me @ swap nextprop
repeat
pop
then
;
: modify-looktraps[ basepath -- ] (* Edit looktraps. 'basepath' is
* / for default look traps or
* some description prop path and should
* end in /
*)
"" var! LookTrapPath
"" var! LookTrapName
"" var! ListName
(* Looktraps go into _details/[look trap name]:value *)
begin
"" 75 tt-tab-init
"Description details are known as \"looktraps\" in MUCK terms. They"
tt-tab-addline
"are viewed by typing 'look SomeName=Detail Name'. Often, people will"
tt-tab-addline
"use these details to describe stuff like tattoos, gear being held,"
tt-tab-addline
"jewelery or other such things. Use this tool to configure them!"
tt-tab-addline
" " tt-tab-addline
basepath @ GLOBAL_ROOT strcmp not if
"You are editing your global look traps. These will be visible no matter"
tt-tab-addline
"which description you have on, unless you override it with a specific"
tt-tab-addline
"setting on an individual description." tt-tab-addline
else
"You are editing a specific description's looktraps. These will override "
"global looktraps and will only be visible when you wear this description."
strcat
tt-tab-addline-wrap
then
" " tt-tab-addline
"1) Additional information and tips about using looktraps."
tt-tab-addline
"2) List looktraps" tt-tab-addline
"3) Add or edit looktrap" tt-tab-addline
"4) Delete looptrap" tt-tab-addline
" " tt-tab-addline
"B) Back to previous menu" tt-tab-addline
"<Choose an Option>" tt-tab-final-flush
read strip tolower
dup "b" strcmp not if
pop exit
then
atoi dup 1 = if
pop
"Look traps are really handy to put additional descriptive text in" tell
"your description without overwhelming the reader with a wall of" tell
"text. The nitty-gritty details can go into looktraps and you can" tell
"give your reader hints they should check them out. Consider this" tell
"example description:" tell
" " tell
"---------------------------------------------------------------------"
tell
"You see Ari the ocelot. She's our model for this demonstration." tell
"Normally, there'd be more details here in the main description." tell
"However, we're just making a demo here. So if you want to see her" tell
"[jewelery] you will need to look at it. Or you can see her [spots]" tell
"because she's an ocelot." tell
" " tell
"You can type 'look Ari=detail' such as 'look Ari=jewelery' to see" tell
"more detail." tell
"---------------------------------------------------------------------"
tell
"<Press any key then enter to continue>" tell
read pop
"So notice a few things that were done to hint to the reader that" tell
"you have details. Square braces like [these] were put around" tell
"things that can be looked at. And the last couple lines of the" tell
"description instruct the reader on how to read those details." tell
" " tell
"You will probably want to do the same with your description if you" tell
"use look traps. You can leave off the square brackets and make" tell
"it more like a game to find looktraps if you prefer, however you" tell
"should definitely hint that you are using look traps because" tell
"people will usually not assume that you are. Hopefully these" tell
"tips are helpful to you!" tell
"<Press any key then enter to continue>" tell
read pop
else dup 2 = if
pop
basepath @ list-looktraps
"<Press any key then enter to continue>" tell
read pop
else dup 3 = if
pop
"First, enter the name of your looktrap. This is what people will use "
"to view the looktrap -- for instance, if you put 'jewerley' here, "
"people will type: look " me @ name strcat "=jewelery" strcat
"... to look at it. You can have aliases if you want. Aliases are"
"separated by semicolon ; -- for example: jewelery;jewels;jewel"
"In such a case, any of those three words will work for the same"
"looktrap. Enter a looktrap name below or type '.abort' to cancel."
7 'cb-get-prop-name input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else
dup LooktrapName !
basepath @ swap strcat LooktrapPath !
me @ LooktrapPath @ getpropstr
strlen if
"This looktrap is already set to:" tell
me @ LooktrapPath @ "(LOOK)" 1 parseprop tell
"...Do you want to change it? (Y)es or (N)o"
1 'cb-yes-no input-loop strip tolower
else
"y" (* No need to ask if already set *)
then
"y" 1 strncmp not if
me @ LooktrapPath @ getpropstr determine-list-name ListName !
(* Load the description for the editor *)
ListName @ strlen not if
me @ LooktrapPath @ getpropstr dup strlen not if
pop 0
else
1 (* Make our single line description into stackrange *)
then
else
ListName @ me @ lmgr-fullrange lmgr-getrange
then
editor (* Run the editor *)
"a" 1 strncmp not if
(* Abort -- don't save *)
popn
else
ListName @ strlen if
me @ ListName @ "#" strcat remove_prop
else
"_looktrap_lists" LooktrapPath @ strcat ListName !
me @ LooktrapPath @ "{list:" ListName @ strcat "}" strcat setprop
then
1 ListName @ me @ lmgr-insertrange
then
else
"Aborting!" tell
then
then
else dup 4 = if
begin
"Which looktrap do you want to delete? You must type the full name of"
tell
"the look trap (sorry). Type '.list' to list your looktraps or '.abort'"
tell
"to abort."
tell
read strip
dup ".list" strcmp not if
pop basepath @ list-looktraps
else dup ".abort" strcmp not if
pop "Aborting!" tell break
else dup "[:/@~]" 0 regexp array_count swap array_count or if
pop "Invalid looktrap name." tell
else dup me @ swap basepath @ swap strcat getpropstr strlen not if
pop "That doesn't seem to be a look trap set on you." tell
else
me @ swap basepath @ swap remove_prop
"Done." tell break
then then then then
repeat
else
pop "Try again?" tell
then then then then
repeat
;
: list-descriptions ( -- ) (* List player's descriptions *)
"" 75 tt-tab-init var! tt
"" var! descname
me @ "_descs/" nextprop
begin
dup strlen while
dup dup strlen 1 midstr "#" strcmp not if
(* This is a description -- add it. First chop off _descs/ and the
* trailing #
*)
dup dup 8 swap strlen 8 - midstr descname !
tt @ descname @ tt-tab-addline
me @ "_descs/" descname @ strcat "/species" strcat getpropstr strlen if
" Species: " me @ "_descs/" descname @ strcat "/species"
strcat getpropstr
strcat tt-tab-addline
then
me @ "_descs/" descname @ strcat "/spec" strcat getpropstr strlen if
" Species: " me @ "_descs/" descname @ strcat "/spec"
strcat getpropstr
strcat tt-tab-addline
then
me @ "_descs/" descname @ strcat "/sex" strcat getpropstr strlen if
" Sex: " me @ "_descs/" descname @ strcat "/sex" strcat getpropstr
strcat tt-tab-addline
then
tt !
then
me @ swap nextprop
repeat
pop
tt @ "counter" [] 1 = if
tt @ "No descriptions set, yet!" tt-tab-addline tt !
then
tt @ "" tt-tab-final-flush
;
: set-senses[ basepath -- ] (* Sets the senses [smell/touch/taste]
* 'basepath' is where we will set the props.
* It should be "/" for global level, or it
* should be the path to the morph.
*)
begin
"" 75 tt-tab-init
basepath @ GLOBAL_ROOT strcmp not if
"You are editing your default sense settings. These will be used if your"
tt-tab-addline
"description doesn't override it." tt-tab-addline
else
"You are editing a specific description's sense settings. These"
tt-tab-addline
"override your defaults if you set them. You can leave them unset"
tt-tab-addline
"to use the defaults." tt-tab-addline
then
" " tt-tab-addline
"1) Set your scent message. Currently:" me @ basepath @ SMELL_PROP strcat
getpropstr dup not if
pop " Unset" strcat tt-tab-addline
else
rot rot tt-tab-addline " " tt-tab-addline swap tt-tab-addline-wrap
" " tt-tab-addline
then
"2) Set your feel message. Currently:" me @ basepath @ FEEL_PROP strcat
getpropstr dup not if
pop " Unset" strcat tt-tab-addline
else
rot rot tt-tab-addline " " tt-tab-addline swap tt-tab-addline-wrap
" " tt-tab-addline
then
"3) Set your taste message. Currently:" me @ basepath @ TASTE_PROP strcat
getpropstr dup not if
pop " Unset" strcat tt-tab-addline
else
rot rot tt-tab-addline " " tt-tab-addline swap tt-tab-addline-wrap
" " tt-tab-addline
then
" " tt-tab-addline
"B) Back" tt-tab-addline
"<Choose an Option>" tt-tab-final-flush
read strip tolower
dup "b" strcmp not if
pop "Done!" tell exit
then
atoi dup 1 = if
pop
"Enter a scent message, or '.abort' to abort, or '.clear' to unset it."
1 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else dup ".clear" strcmp not if
pop "Clearing it!" me @ basepath @ SMELL_PROP strcat remove_prop
else
me @ swap basepath @ SMELL_PROP strcat swap setprop
"Set!" tell
then then
else dup 2 = if
pop
"Enter a feel message, or '.abort' to abort, or '.clear' to unset it."
1 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else dup ".clear" strcmp not if
pop "Clearing it!" me @ basepath @ FEEL_PROP strcat remove_prop
else
me @ swap basepath @ FEEL_PROP strcat swap setprop
"Set!" tell
then then
else dup 3 = if
pop
"Enter a taste message, or '.abort' to abort, or '.clear' to unset it."
1 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else dup ".clear" strcmp not if
pop "Clearing it!" me @ basepath @ TASTE_PROP strcat remove_prop
else
me @ swap basepath @ TASTE_PROP strcat swap setprop
"Set!" tell
then then
else
pop "Invalid option." tell
then then then
repeat
;
: add-or-edit-description[ str:descname -- ] (* The underlying engine for
* editing or adding a new
* description. Take the
* description name as a
* parameter.
*)
"" var! ListName
begin
"" 75 tt-tab-init
"1) Set override species (Currently: "
me @ "_descs/" descname @ strcat "/spec" strcat getpropstr
dup strlen not if
pop "Using Default"
then
strcat ")" strcat tt-tab-addline
"2) Set override gender (Currently: "
me @ "_descs/" descname @ strcat "/sex" strcat getpropstr
dup strlen not if
pop "Using Default"
then
strcat ")" strcat tt-tab-addline
"3) Set details specific to this description (\"Looktraps\")"
tt-tab-addline
"4) Set message to yourself when changing to this description."
tt-tab-addline
"5) Set message to show others when changing to this description."
tt-tab-addline
"6) Set smell, touch, and feel." tt-tab-addline
"7) Set description text" tt-tab-addline
" " tt-tab-addline
"B) Back to previous menu" tt-tab-addline
"<Choose an Option>" tt-tab-final-flush
read strip tolower
dup "b" strcmp not if
pop exit
then
atoi dup 1 = if
pop
"You can change your species as part of the description change if you"
"want. Or you can leave this unset and it will use whatever species"
"you set on the main screen. Type '.abort' to do nothing, '.clear' "
"to clear this setting and use the default, or whatever species you "
"would like."
5 'cb-get-any-string input-loop
strip
dup ".abort" strcmp not if
pop "Aborting." tell
else dup ".clear" strcmp not if
pop me @ "_descs/" descname @ strcat "/spec" strcat remove_prop
"Using default species." tell
else
me @ swap "_descs/" descname @ strcat "/spec" strcat swap setprop
"Species set." tell
then then
else dup 2 = if
pop
"You can change your gender as part of the description change if you"
"want. Or you can leave this unset and it will use whatever gender"
"you set on the main screen. Type '.abort' to do nothing, '.clear' "
"to clear this setting and use the default, or whatever gender you "
"would like."
5 'cb-get-any-string input-loop
strip
dup ".abort" strcmp not if
pop "Aborting." tell
else dup ".clear" strcmp not if
pop me @ "_descs/" descname @ strcat "/sex" strcat remove_prop
"Using default gender." tell
else
me @ swap "_descs/" descname @ strcat "/sex" strcat swap setprop
"Gender set." tell
then then
else dup 3 = if
pop "_descs/" descname @ strcat "/_details/" strcat modify-looktraps
else dup 4 = if
pop me @ "_descs/" descname @ strcat "/message" strcat getpropstr
dup strlen if
"Currently, when you change descriptions, you will see:" tell
tell
"Enter a new message, type '.abort' to abort, or '.clear' to clear it."
1 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else dup ".clear" strcmp not if
pop "Clearing!" tell
me @ "_descs/" descname @ strcat "/message" strcat remove_prop
else
me @ swap "_descs/" descname @ strcat "/message" strcat swap
setprop
"Set!" tell
then then
else
pop
"Enter a message that will be seen by you when you change descriptions,"
"or type '.abort' to abort."
2 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else
me @ swap "_descs/" descname @ strcat "/message" strcat swap
setprop
"Set!" tell
then
then
else dup 5 = if
pop me @ "_descs/" descname @ strcat "/omessage" strcat getpropstr
dup strlen if
"Currently, when you change descriptions, others will see:" tell
me @ name " " strcat swap strcat tell
"There's no need to put your name at the start of the message, it " tell
"will be added for you." tell
"Enter a new message, type '.abort' to abort, or '.clear' to clear it."
1 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else dup ".clear" strcmp not if
pop "Clearing!" tell
me @ "_descs/" descname @ strcat "/omessage" strcat remove_prop
else
me @ swap "_descs/" descname @ strcat "/omessage" strcat swap
setprop
"Set!" tell
then then
else
pop
"Enter a message that will be seen by others when you change "
"descriptions, or type '.abort' to abort. Your name will be put "
"as the first word of the message so you don't need to include that."
3 'cb-get-any-string input-loop strip
dup ".abort" strcmp not if
pop "Aborting!" tell
else
me @ swap "_descs/" descname @ strcat "/omessage" strcat swap
setprop
"Set!" tell
then
then
else dup 6 = if
pop
"_descs/" descname @ strcat "/" strcat set-senses
else dup 7 = if
pop
"_descs/" descname @ strcat me @ lmgr-fullrange lmgr-getrange
editor
"a" 1 strncmp not if
(* Abort, don't save *)
popn
else
me @ "_descs/" descname @ strcat "#" strcat remove_prop
1 "_descs/" descname @ strcat me @ lmgr-insertrange
then
else
"Try again?" tell
then then then then then then then
repeat
;
: cleanup-description[ str:current -- ] (* Cleans up a description, removing
* all its look traps and unsetting
* any props that it set.
*)
(*
* Method -- all these actions are taken ONLY if the description uses them.
*
* - unset species
* - unset gender
* - unset senses
* - unset looktraps specific to description
*)
"_descs/" current @ strcat "/" strcat var! base
me @ base @ "spec" strcat getpropstr strlen
me @ base @ "species" strcat getpropstr strlen or if
me @ "species" remove_prop
then
(* These are all handled the same *)
{ "sex" SMELL_PROP FEEL_PROP TASTE_PROP }list
foreach
dup me @ swap base @ swap strcat getpropstr strlen if
me @ swap remove_prop
else
pop
then
pop
repeat
(* Delete looktraps *)
me @ base @ "_details/" strcat nextprop
begin
dup strlen while
dup base @ split swap pop
me @ swap remove_prop
me @ swap nextprop
repeat
pop
;
: setup-description[ str:base -- ] (* Sets up a description. This copies
* all the properties over. The 'base'
* parameter should be the PATH to the
* description and not just the name.
*
* Reason is, this can also work with
* the global settings.
*
* Base should end with /
*)
me @ base @ "spec" strcat getpropstr strlen if
me @ "species" me @ base @ "spec" strcat getpropstr setprop
then
(* Copy these props straight over *)
{ "species" "sex" SMELL_PROP FEEL_PROP TASTE_PROP }list
foreach
dup me @ swap base @ swap strcat getpropstr dup strlen if
( @ "propname" "value" )
me @ -rot setprop
else
pop pop
then
pop
repeat
(* Copy over looktraps *)
me @ base @ "_details/" strcat nextprop
begin
dup strlen while
dup dup me @ swap getpropstr
( "path" "path" "value" )
swap base @ split swap pop
swap me @ -rot setprop
me @ swap nextprop
repeat
pop
(* Set up description -- only if we need to. The old morpher 's MPI
* will work with the new morpher, and if we preserve the old morpher's
* MPI, both morphers will continue to work.
*
* Don't do this when setting up globals
*)
base @ GLOBAL_ROOT strcmp if
me @ "_/de" getpropstr "{my-desc}" strcmp if
me @ "_/de" "{null:{tell:>>> {name:me} looked at you!,#" me @ intostr
strcat "}}{list:" strcat base @ "/" rsplit pop strcat "}" strcat setprop
then
then
;
: morph ( s b -- ) (* Changes to the given description, showing messages if
* desired. If b is true, show messages.
*)
(* Does the description exist? *)
swap dup me @ swap "_descs/" swap strcat "#" strcat propdir? not if
pop pop
"It doesn't look like you have a description by that name. Try again?"
tell exit
then
swap
if
dup me @ swap "_descs/" swap strcat "/message" strcat getpropstr
dup strlen if
tell
else
pop
dup "Your description is now: " swap strcat tell
then
dup me @ swap "_descs/" swap strcat "/omessage" strcat getpropstr
dup strlen if
me @ name " " strcat swap strcat otell
else
pop
then
else
dup "(Silent Change) Your description is now: " swap strcat tell
then
(* What's our current description if any? Let's clean it up if needed *)
me @ "_descs/prefs/current" getpropstr dup strlen if
cleanup-description
else
pop
then
(* set globals *)
GLOBAL_ROOT setup-description
(* And the description itself *)
dup "_descs/" swap strcat "/" strcat setup-description
me @ swap "_descs/prefs/current" swap setprop
(* Done! *)
;
: add-description ( -- ) (* Add a description for this user *)
begin
"Enter a name for the new description. This is used to change descriptions"
"in case you want to have multiple outfits. It can have letters, numbers, "
"- or _. \"normal\" or \"dressed\" are good to start with."
" "
"If you want to cancel, type '.abort'."
5 'cb-get-desc-name input-loop
dup ".list" strcmp not if pop list-descriptions
else dup ".abort" strcmp not if pop exit
else
(* Make a stub description so it shows up in the list *)
dup me @ swap "_descs/" swap strcat "#" strcat "0" setprop
dup add-or-edit-description
"Would you like to switch to your new description?"
"Type 'y'es or 'n'o."
2 'cb-yes-no input-loop
"y" 1 strncmp not if
0 morph
else
pop
then
exit
then then
repeat
;
: edit-description ( -- ) (* Edit a description for this user *)
begin
"Type the name of the description you want to edit. You can type '.list'"
"to list your descriptions. Descriptions are case insensitive."
" "
"If you want to cancel, type '.abort'."
4 'cb-get-desc-name input-loop
dup ".list" strcmp not if pop list-descriptions
else dup ".abort" strcmp not if pop exit
else add-or-edit-description exit
then then
repeat
;
: delete-description ( -- ) (* Deletes a description *)
begin
"Type the name of the description you want to delete. You can type '.list'"