-
Notifications
You must be signed in to change notification settings - Fork 38
/
typhak.mud
128 lines (107 loc) · 3.12 KB
/
typhak.mud
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
<DEFINE CEVENT-PRINT (EV "AUX" (OUTCHAN .OUTCHAN))
#DECL ((EV) CEVENT)
<PRINC "#CEVENT [">
<COND (<CFLAG .EV> <PRINC "ENABLED">)
(<PRINC "DISABLED">)>
<PRINC " @ ">
<PRIN1 <CTICK .EV>>
<PRINC " -> ">
<FUNCTION-PRINT <CACTION .EV>>
<PRINC "]">>
<PRINTTYPE CEVENT ,CEVENT-PRINT>
<DEFINE FUNCTION-PRINT (FROB "AUX" (OUTCHAN .OUTCHAN))
#DECL ((FROB) <OR ATOM NOFFSET APPLICABLE FALSE> (OUTCHAN) CHANNEL)
<COND (<NOT .FROB> <PRINC "<>">)
(<TYPE? .FROB RSUBR RSUBR-ENTRY>
<PRIN1 <2 .FROB>>)
(<TYPE? .FROB ATOM>
<PRIN1 .FROB>)
(<TYPE? .FROB NOFFSET>
<PRINC "#NOFFSET ">
<PRIN1 <GET-ATOM .FROB>>)
(<PRINC "#FUNCTION ">
<PRIN1 <GET-ATOM .FROB>>)>>
<DEFINE OFF-APPLY (FOO "TUPLE" ARGS)
#DECL ((FOO) NOFFSET)
<COND (<G? <LENGTH .ARGS> 1>
<ERROR TOO-MANY-ARGS OFF-APPLY>)
(<OR <EMPTY? .ARGS>
<NOT <1 .ARGS>>>
<DISPATCH .FOO>)
(T
<DISPATCH .FOO <1 .ARGS>>)>>
<DEFINE OFF-PRINT (FOO)
#DECL ((FOO) NOFFSET)
<PRINC "#NOFFSET ">
<PRIN1 <GET-ATOM .FOO>>>
<APPLYTYPE NOFFSET ,OFF-APPLY>
<PRINTTYPE NOFFSET ,OFF-PRINT>
<DEFINE ROOM-PRINT (ROOM)
#DECL ((ROOM) ROOM)
<PRINC "#ROOM [">
<PSTRING-PRINT <RID .ROOM> <>>
<PRINC " \\\"">
<PRINC <RDESC2 .ROOM>>
<PRINC "\\\"">
<COND (<EMPTY? <REXITS .ROOM>>)
(<PRINC " ">
<REPEAT ((EX <REXITS .ROOM>))
<PRINC <1 .EX>>
<COND (<EMPTY? <SET EX <REST .EX 2>>> <RETURN>)
(<PRINC " ">)>>)>
<COND (<EMPTY? <ROBJS .ROOM>>)
(<MAPF <>
<FUNCTION (X)
#DECL ((X) OBJECT)
<PRINC " ">
<PRINC <OID .X>>>
<ROBJS .ROOM>>)>
<PRINC " ">
<FUNCTION-PRINT <RACTION .ROOM>>
<PRINC "]">>
<PRINTTYPE ROOM ,ROOM-PRINT>
<DEFINE OBJ-PRINT (OBJ)
#DECL ((OBJ) OBJECT)
<PRINC "#OBJECT [">
<COND (<EMPTY? <ONAMES .OBJ>> <PRINC !\?>)
(<PSTRING-PRINT <OID .OBJ> <>>)>
<PRINC " ">
<PRINC <ODESC2 .OBJ>>
<COND (<NOT <EMPTY? <OCONTENTS .OBJ>>>
<PRINC " ">
<MAPF <>
<FUNCTION (X) <PRINC <OID .X>> <PRINC " ">>
<OCONTENTS .OBJ>>)
(<OCAN .OBJ> <PRINC " in "> <PRINC <OID <OCAN .OBJ>>> <PRINC " ">)
(<PRINC " ">)>
<FUNCTION-PRINT <OACTION .OBJ>>
<PRINC "]">>
<PRINTTYPE OBJECT ,OBJ-PRINT>
<DEFINE HACK-PRINT (HACK)
#DECL ((HACK) HACK)
<PRINC "#HACK [">
<FUNCTION-PRINT <HACTION .HACK>>
<PRINC !\ >
<PRIN1 <HOBJS .HACK>>
<PRINC !\]>>
<PRINTTYPE HACK ,HACK-PRINT>
<DEFINE ACTION-PRINT (ACT "AUX" (OUTCHAN .OUTCHAN))
#DECL ((ACT) ACTION (OUTCHAN) CHANNEL)
<PRINC "#ACTION ">
<PRINC <VSTR .ACT>>>
<PRINTTYPE ACTION ,ACTION-PRINT>
<DEFINE PSTRING-PRINT (OBJ "OPTIONAL" (TYPE-PRINT T) "AUX" (BP 36) C)
#DECL ((OBJ) <PRIMTYPE WORD> (BP C) FIX (TYPE-PRINT) <OR ATOM FALSE>)
<COND (.TYPE-PRINT <PRINC !\#> <PRIN1 <TYPE .OBJ>> <PRINC !\ >)>
<MAPF <>
<FUNCTION ()
<COND (<G? <SET BP <- .BP 7>> 0>
<COND (<N==? <SET C <CHTYPE <GETBITS .OBJ <BITS 7 .BP>> FIX>>
0>
<PRINC <ASCII .C>>)>)
(T <MAPLEAVE .OBJ>)>>>>
<PRINTTYPE PSTRING ,PSTRING-PRINT>
<PRINTTYPE PREP ,PSTRING-PRINT>
<PRINTTYPE DIRECTION ,PSTRING-PRINT>
<PRINTTYPE ADJECTIVE ,PSTRING-PRINT>
<PRINTTYPE BUZZ ,PSTRING-PRINT>