API tools faq
paste
View difference between Paste ID: wY7ydmMX and npu7224v
SHOW: | | - or go back to the newest paste.
1
$def maxstring 64000 2 /
2
lvar filler_text
3
$def filler filler_text @ not if "****************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************" begin dup strcat dup strlen maxstring > if maxstring strcut pop break then repeat dup filler_text ! else filler_text @ then
4
5
: object2JSON[ any:input -- array of strings ]
6
   input @ string? if input @ strlen maxstring -- > if maxstring "JSON: String exceeds %i char limit." fmtstring abort then then
7
   input @ string? if { "\"" input @ "\\\\" "\\" subst "\\\"" "\"" subst "\\/" "/" subst "\"" }cat 1 array_make exit then
8
   input @ int? if input @ intostr 1 array_make exit then
9
   input @ float? if input @ "%f" fmtstring 1 array_make exit then
10
   input @ dbref? if input @ "%d#" fmtstring 1 array_make exit then
11
   input @ lock? if input @ unparselock "\\\\" "\\" subst "\\%" "%" subst "%%%s%%" fmtstring 1 array_make exit then
12
   0 array_make var! output
13
   input @ dictionary? if
14
      "{" output @ array_appenditem output !
15
      input @ foreach var! value var! key
16
         key @ object2JSON output @ dup array_last pop ++ rot array_insertrange output !
17
         ":" output @ array_appenditem output !
18
         value @ object2JSON output @ dup array_last pop ++ rot array_insertrange output !
19
         "," output @ array_appenditem output !
20
      repeat
21
      "}" output @ dup array_last pop array_setitem exit
22
   then
23
   input @ array? if
24
      "[" output @ array_appenditem output !
25
      input @ foreach var! value pop
26
         value @ object2JSON output @ dup array_last pop ++ rot array_insertrange output !
27
         "," output @ array_appenditem output !
28
      repeat
29
      "]" output @ dup array_last pop array_setitem exit
30
   then
31
   "JSON: Error in object2JSON" abort
32
; PUBLIC object2JSON
33
$libdef object2JSON
34
35
: JSONmember[ str:input -- key value ]
36
   input @ 1 array_make "$lib/damagedJSON" match "JSON2object" call
37
   dup 0 array_getitem swap 1 array_getitem
38
; SAFECALL JSONmember
39
40
: JSONelement[ str:input -- value ]
41
   input @ 1 array_make "$lib/damagedJSON" match "JSON2object" call
42
   0 array_getitem
43
;
44
45
46
: JSON2object[ array:JSONarray -- arr:data ]
47
"" var! JSONstring
48
0 array_make var! output
49
begin
50
   JSONstring @ not if
51
      JSONarray @ 0 array_getitem JSONstring !
52
      JSONarray @ 0 array_delitem JSONarray !
53
   then
54
   JSONstring @ case
55
      "{" instr 1 = when
56
         JSONstring @ 1 strcut nip JSONstring !
57
         0 array_make_dict
58
         begin
59
            JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup dup "," instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < swap dup "," instr ?dup not if 99999999 then swap "}" instr ?dup not if 9999999 then < and if
60
               JSONstring @ dup
61
               begin
62-
                  dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat then
62+
                  dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
63-
               repeat
63+
                  dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
64
                  dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then
65
               1 until
66
               "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^,])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONmember rot rot array_setitem
67
               continue
68
            else
69
               JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup "}" instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < if
70-
                     dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat then
70+
71-
                  repeat 

71+
72
                     dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

73
                     dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

74
                     dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

75
                  1 until

76
                  "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^\\}])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONmember rot rot array_setitem

77
                  output @ array_appenditem output !

78
                  break

79
               then

80
            then

81
            JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

82
            JSONarray @ 0 array_delitem JSONarray !

83
         repeat

84
      end

85
      "[" instr 1 = when

86
         JSONstring @ 1 strcut nip JSONstring !

87
         0 array_make

88-
                  dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat then

88+
89-
               repeat 

89+
90
               JSONstring @ dup 

91
               begin

92
                  dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

93
                  dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

94
                  dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

95
               1 until

96-
                     dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem not if break else x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat then

96+
97-
                  repeat 

97+
98
            else

99
               JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" "" REG_ALL regsub dup "]" instr ?dup not if 99999999 then swap "\"" instr ?dup not if 9999999 then < if 

100
                  JSONstring @ dup

101
                  begin

102
                     dup "\"([^\"]*)\"" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

103
                     dup "\\[([^\\[\\]]*)\\]" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

104
                     dup "\\{([^\\{\\}]*)\\}" REG_ALL regexp var! x 0 array_getitem if x @ 0 array_getitem 1 array_getitem filler swap strcut pop swap x @ 0 array_getitem 0 array_getitem -- strcut x @ 0 array_getitem 1 array_getitem strcut nip rot swap strcat strcat continue then

105
                  1 until

106
                  "^(\\[[^\\]]*\\]|\\{[^\\}]*\\}|\"[^\"]*\"|[^\\]])*" REG_ALL regexp nip 0 array_getitem 1 array_getitem strcut 1 strcut nip JSONstring ! JSONelement swap array_appenditem

107
                  output @ array_appenditem output !

108
                  break

109
               then

110
            then

111
            JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

112
            JSONarray @ 0 array_delitem JSONarray !

113
         repeat

114
      end

115
      "\"" instr 1 = when

116
         begin

117
            JSONstring @ "\"([^\"\\\\]*|\\\\[\"\\\\\\/bfnrt]|\\\\u[0-9a-f]{4})*\"" REG_ICASE regexp 0 array_getitem swap not if 

118
               pop

119
               JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

120
               JSONarray @ 0 array_delitem JSONarray !

121
               continue

122
            then

123
            JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "\"" rsplit pop 

124
            "\"" "\\\"" subst "/" "\\/" subst "\\" "\\\\" subst

125
            output @ array_appenditem output !

126
         1 until

127
      end

128
      "#" instr 1 = when

129
         begin

130
            JSONstring @ "#[0-9]*#" REG_ICASE regexp 0 array_getitem swap not if 

131
               pop

132
               JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

133
               JSONarray @ 0 array_delitem JSONarray !

134
               continue

135
            then

136
            JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "#" rsplit pop stod output @ array_appenditem output !

137
         1 until

138
      end

139
      "%" instr 1 = when

140
         begin

141
            JSONstring @ "%([^\\\\%]*|\\\\[\\\\%])*%" REG_ICASE regexp 0 array_getitem swap not if 

142
               pop

143
               JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

144
               JSONarray @ 0 array_delitem JSONarray !

145
               continue

146
            then

147
            JSONstring @ swap 1 array_getitem strcut JSONstring ! 1 strcut nip "#" rsplit pop 

148
            "%" "\\%" subst "\\" "\\\\" subst parselock

149
            output @ array_appenditem output !

150
         1 until

151
      end

152
      ":" instr 1 = when

153
         JSONstring @ 1 strcut nip JSONstring !

154
      end

155
      dup "true" instring 1 = swap "false" instring 1 = or when

156
         begin

157
            JSONstring @ "true|false" REG_ICASE regexp swap not if 

158
               pop

159
               JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

160
               JSONarray @ 0 array_delitem JSONarray !

161
               continue

162
            then

163
            0 array_getitem JSONstring @ swap 1 array_getitem strcut JSONstring ! "true" stringcmp not if 1 else 0 then output @ array_appenditem output !

164
         1 until

165
      end

166
      pop 1 when

167
         begin

168
            JSONstring @ "-?(?=[1-9]|0(?!\\d))\\d+(\\.\\d+)?([eE][+-]?\\d+)?" REG_ICASE regexp swap not if 

169
               pop

170
               JSONstring @ JSONarray @ 0 array_getitem ?dup not if "" then strcat JSONstring !

171
               JSONarray @ 0 array_delitem JSONarray !

172
               continue

173
            then

174
            0 array_getitem JSONstring @ swap 1 array_getitem strcut JSONstring ! dup var! number

175
            dup atoi swap strtof floor int = if

176
               number @ atoi

177
            else

178
               number @ strtof

179
            then  

180
            output @ array_appenditem output !

181
         1 until

182
      end

183
   endcase

184
JSONarray @ not JSONstring @ not and until

185
output @

186
; PUBLIC JSON2object

187
$libdef JSON2object
        

    


            


                                


        

            



                
    

        Public Pastes
    

    
            

    

                    

        

    





    


    
    
    
    
    
    
    
    




    


    



                

            We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.             OK, I Understand
        

    
                

            

                
                    
                
            

            

                Not a member of Pastebin yet?

                Sign Up, it unlocks many cool features!