Fix conflict
Slava Pestov
commit
ae0da1cf98
|
|
@ -11,6 +11,7 @@ Factor/factor
|
|||
*.image
|
||||
*.dylib
|
||||
factor
|
||||
factor.com
|
||||
*#*#
|
||||
.DS_Store
|
||||
.gdb_history
|
||||
|
|
|
|||
18
Makefile
18
Makefile
|
|
@ -17,12 +17,12 @@ else
|
|||
CFLAGS += -O3 $(SITE_CFLAGS)
|
||||
endif
|
||||
|
||||
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
||||
|
||||
ifdef CONFIG
|
||||
include $(CONFIG)
|
||||
endif
|
||||
|
||||
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
||||
|
||||
DLL_OBJS = $(PLAF_DLL_OBJS) \
|
||||
vm/alien.o \
|
||||
vm/bignum.o \
|
||||
|
|
@ -129,15 +129,7 @@ solaris-x86-32:
|
|||
solaris-x86-64:
|
||||
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
|
||||
|
||||
freetype6.dll:
|
||||
wget http://factorcode.org/dlls/freetype6.dll
|
||||
chmod 755 freetype6.dll
|
||||
|
||||
zlib1.dll:
|
||||
wget http://factorcode.org/dlls/zlib1.dll
|
||||
chmod 755 zlib1.dll
|
||||
|
||||
winnt-x86-32: freetype6.dll zlib1.dll
|
||||
winnt-x86-32:
|
||||
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
||||
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
||||
|
||||
|
|
@ -158,7 +150,7 @@ macosx.app: factor
|
|||
-change libfactor.dylib \
|
||||
@executable_path/../Frameworks/libfactor.dylib \
|
||||
Factor.app/Contents/MacOS/factor
|
||||
|
||||
|
||||
factor: $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
|
|
@ -167,7 +159,7 @@ factor: $(DLL_OBJS) $(EXE_OBJS)
|
|||
factor-console: $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
|
||||
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
|
||||
|
||||
clean:
|
||||
rm -f vm/*.o
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test colors.constants colors ;
|
||||
IN: colors.constants.tests
|
||||
|
||||
[ t ] [ COLOR: light-green rgba? ] unit-test
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel assocs math math.parser memoize
|
||||
io.encodings.ascii io.files lexer parser
|
||||
colors sequences splitting combinators.smart ascii ;
|
||||
IN: colors.constants
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: parse-color ( line -- name color )
|
||||
[
|
||||
[ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
|
||||
[ blank? ] trim-head { { CHAR: \s CHAR: - } } substitute swap
|
||||
] input<sequence ;
|
||||
|
||||
: parse-rgb.txt ( lines -- assoc )
|
||||
[ "!" head? not ] filter
|
||||
[ 11 cut [ " \t" split harvest ] dip suffix ] map
|
||||
[ parse-color ] H{ } map>assoc ;
|
||||
|
||||
MEMO: rgb.txt ( -- assoc )
|
||||
"resource:basis/colors/constants/rgb.txt" ascii file-lines parse-rgb.txt ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
ERROR: no-such-color name ;
|
||||
|
||||
: named-color ( name -- rgb )
|
||||
dup rgb.txt at [ ] [ no-such-color ] ?if ;
|
||||
|
||||
: COLOR: scan named-color parsed ; parsing
|
||||
|
|
@ -0,0 +1,753 @@
|
|||
! $Xorg: rgb.txt,v 1.3 2000/08/17 19:54:00 cpqbld Exp $
|
||||
255 250 250 snow
|
||||
248 248 255 ghost white
|
||||
248 248 255 GhostWhite
|
||||
245 245 245 white smoke
|
||||
245 245 245 WhiteSmoke
|
||||
220 220 220 gainsboro
|
||||
255 250 240 floral white
|
||||
255 250 240 FloralWhite
|
||||
253 245 230 old lace
|
||||
253 245 230 OldLace
|
||||
250 240 230 linen
|
||||
250 235 215 antique white
|
||||
250 235 215 AntiqueWhite
|
||||
255 239 213 papaya whip
|
||||
255 239 213 PapayaWhip
|
||||
255 235 205 blanched almond
|
||||
255 235 205 BlanchedAlmond
|
||||
255 228 196 bisque
|
||||
255 218 185 peach puff
|
||||
255 218 185 PeachPuff
|
||||
255 222 173 navajo white
|
||||
255 222 173 NavajoWhite
|
||||
255 228 181 moccasin
|
||||
255 248 220 cornsilk
|
||||
255 255 240 ivory
|
||||
255 250 205 lemon chiffon
|
||||
255 250 205 LemonChiffon
|
||||
255 245 238 seashell
|
||||
240 255 240 honeydew
|
||||
245 255 250 mint cream
|
||||
245 255 250 MintCream
|
||||
240 255 255 azure
|
||||
240 248 255 alice blue
|
||||
240 248 255 AliceBlue
|
||||
230 230 250 lavender
|
||||
255 240 245 lavender blush
|
||||
255 240 245 LavenderBlush
|
||||
255 228 225 misty rose
|
||||
255 228 225 MistyRose
|
||||
255 255 255 white
|
||||
0 0 0 black
|
||||
47 79 79 dark slate gray
|
||||
47 79 79 DarkSlateGray
|
||||
47 79 79 dark slate grey
|
||||
47 79 79 DarkSlateGrey
|
||||
105 105 105 dim gray
|
||||
105 105 105 DimGray
|
||||
105 105 105 dim grey
|
||||
105 105 105 DimGrey
|
||||
112 128 144 slate gray
|
||||
112 128 144 SlateGray
|
||||
112 128 144 slate grey
|
||||
112 128 144 SlateGrey
|
||||
119 136 153 light slate gray
|
||||
119 136 153 LightSlateGray
|
||||
119 136 153 light slate grey
|
||||
119 136 153 LightSlateGrey
|
||||
190 190 190 gray
|
||||
190 190 190 grey
|
||||
211 211 211 light grey
|
||||
211 211 211 LightGrey
|
||||
211 211 211 light gray
|
||||
211 211 211 LightGray
|
||||
25 25 112 midnight blue
|
||||
25 25 112 MidnightBlue
|
||||
0 0 128 navy
|
||||
0 0 128 navy blue
|
||||
0 0 128 NavyBlue
|
||||
100 149 237 cornflower blue
|
||||
100 149 237 CornflowerBlue
|
||||
72 61 139 dark slate blue
|
||||
72 61 139 DarkSlateBlue
|
||||
106 90 205 slate blue
|
||||
106 90 205 SlateBlue
|
||||
123 104 238 medium slate blue
|
||||
123 104 238 MediumSlateBlue
|
||||
132 112 255 light slate blue
|
||||
132 112 255 LightSlateBlue
|
||||
0 0 205 medium blue
|
||||
0 0 205 MediumBlue
|
||||
65 105 225 royal blue
|
||||
65 105 225 RoyalBlue
|
||||
0 0 255 blue
|
||||
30 144 255 dodger blue
|
||||
30 144 255 DodgerBlue
|
||||
0 191 255 deep sky blue
|
||||
0 191 255 DeepSkyBlue
|
||||
135 206 235 sky blue
|
||||
135 206 235 SkyBlue
|
||||
135 206 250 light sky blue
|
||||
135 206 250 LightSkyBlue
|
||||
70 130 180 steel blue
|
||||
70 130 180 SteelBlue
|
||||
176 196 222 light steel blue
|
||||
176 196 222 LightSteelBlue
|
||||
173 216 230 light blue
|
||||
173 216 230 LightBlue
|
||||
176 224 230 powder blue
|
||||
176 224 230 PowderBlue
|
||||
175 238 238 pale turquoise
|
||||
175 238 238 PaleTurquoise
|
||||
0 206 209 dark turquoise
|
||||
0 206 209 DarkTurquoise
|
||||
72 209 204 medium turquoise
|
||||
72 209 204 MediumTurquoise
|
||||
64 224 208 turquoise
|
||||
0 255 255 cyan
|
||||
224 255 255 light cyan
|
||||
224 255 255 LightCyan
|
||||
95 158 160 cadet blue
|
||||
95 158 160 CadetBlue
|
||||
102 205 170 medium aquamarine
|
||||
102 205 170 MediumAquamarine
|
||||
127 255 212 aquamarine
|
||||
0 100 0 dark green
|
||||
0 100 0 DarkGreen
|
||||
85 107 47 dark olive green
|
||||
85 107 47 DarkOliveGreen
|
||||
143 188 143 dark sea green
|
||||
143 188 143 DarkSeaGreen
|
||||
46 139 87 sea green
|
||||
46 139 87 SeaGreen
|
||||
60 179 113 medium sea green
|
||||
60 179 113 MediumSeaGreen
|
||||
32 178 170 light sea green
|
||||
32 178 170 LightSeaGreen
|
||||
152 251 152 pale green
|
||||
152 251 152 PaleGreen
|
||||
0 255 127 spring green
|
||||
0 255 127 SpringGreen
|
||||
124 252 0 lawn green
|
||||
124 252 0 LawnGreen
|
||||
0 255 0 green
|
||||
127 255 0 chartreuse
|
||||
0 250 154 medium spring green
|
||||
0 250 154 MediumSpringGreen
|
||||
173 255 47 green yellow
|
||||
173 255 47 GreenYellow
|
||||
50 205 50 lime green
|
||||
50 205 50 LimeGreen
|
||||
154 205 50 yellow green
|
||||
154 205 50 YellowGreen
|
||||
34 139 34 forest green
|
||||
34 139 34 ForestGreen
|
||||
107 142 35 olive drab
|
||||
107 142 35 OliveDrab
|
||||
189 183 107 dark khaki
|
||||
189 183 107 DarkKhaki
|
||||
240 230 140 khaki
|
||||
238 232 170 pale goldenrod
|
||||
238 232 170 PaleGoldenrod
|
||||
250 250 210 light goldenrod yellow
|
||||
250 250 210 LightGoldenrodYellow
|
||||
255 255 224 light yellow
|
||||
255 255 224 LightYellow
|
||||
255 255 0 yellow
|
||||
255 215 0 gold
|
||||
238 221 130 light goldenrod
|
||||
238 221 130 LightGoldenrod
|
||||
218 165 32 goldenrod
|
||||
184 134 11 dark goldenrod
|
||||
184 134 11 DarkGoldenrod
|
||||
188 143 143 rosy brown
|
||||
188 143 143 RosyBrown
|
||||
205 92 92 indian red
|
||||
205 92 92 IndianRed
|
||||
139 69 19 saddle brown
|
||||
139 69 19 SaddleBrown
|
||||
160 82 45 sienna
|
||||
205 133 63 peru
|
||||
222 184 135 burlywood
|
||||
245 245 220 beige
|
||||
245 222 179 wheat
|
||||
244 164 96 sandy brown
|
||||
244 164 96 SandyBrown
|
||||
210 180 140 tan
|
||||
210 105 30 chocolate
|
||||
178 34 34 firebrick
|
||||
165 42 42 brown
|
||||
233 150 122 dark salmon
|
||||
233 150 122 DarkSalmon
|
||||
250 128 114 salmon
|
||||
255 160 122 light salmon
|
||||
255 160 122 LightSalmon
|
||||
255 165 0 orange
|
||||
255 140 0 dark orange
|
||||
255 140 0 DarkOrange
|
||||
255 127 80 coral
|
||||
240 128 128 light coral
|
||||
240 128 128 LightCoral
|
||||
255 99 71 tomato
|
||||
255 69 0 orange red
|
||||
255 69 0 OrangeRed
|
||||
255 0 0 red
|
||||
255 105 180 hot pink
|
||||
255 105 180 HotPink
|
||||
255 20 147 deep pink
|
||||
255 20 147 DeepPink
|
||||
255 192 203 pink
|
||||
255 182 193 light pink
|
||||
255 182 193 LightPink
|
||||
219 112 147 pale violet red
|
||||
219 112 147 PaleVioletRed
|
||||
176 48 96 maroon
|
||||
199 21 133 medium violet red
|
||||
199 21 133 MediumVioletRed
|
||||
208 32 144 violet red
|
||||
208 32 144 VioletRed
|
||||
255 0 255 magenta
|
||||
238 130 238 violet
|
||||
221 160 221 plum
|
||||
218 112 214 orchid
|
||||
186 85 211 medium orchid
|
||||
186 85 211 MediumOrchid
|
||||
153 50 204 dark orchid
|
||||
153 50 204 DarkOrchid
|
||||
148 0 211 dark violet
|
||||
148 0 211 DarkViolet
|
||||
138 43 226 blue violet
|
||||
138 43 226 BlueViolet
|
||||
160 32 240 purple
|
||||
147 112 219 medium purple
|
||||
147 112 219 MediumPurple
|
||||
216 191 216 thistle
|
||||
255 250 250 snow1
|
||||
238 233 233 snow2
|
||||
205 201 201 snow3
|
||||
139 137 137 snow4
|
||||
255 245 238 seashell1
|
||||
238 229 222 seashell2
|
||||
205 197 191 seashell3
|
||||
139 134 130 seashell4
|
||||
255 239 219 AntiqueWhite1
|
||||
238 223 204 AntiqueWhite2
|
||||
205 192 176 AntiqueWhite3
|
||||
139 131 120 AntiqueWhite4
|
||||
255 228 196 bisque1
|
||||
238 213 183 bisque2
|
||||
205 183 158 bisque3
|
||||
139 125 107 bisque4
|
||||
255 218 185 PeachPuff1
|
||||
238 203 173 PeachPuff2
|
||||
205 175 149 PeachPuff3
|
||||
139 119 101 PeachPuff4
|
||||
255 222 173 NavajoWhite1
|
||||
238 207 161 NavajoWhite2
|
||||
205 179 139 NavajoWhite3
|
||||
139 121 94 NavajoWhite4
|
||||
255 250 205 LemonChiffon1
|
||||
238 233 191 LemonChiffon2
|
||||
205 201 165 LemonChiffon3
|
||||
139 137 112 LemonChiffon4
|
||||
255 248 220 cornsilk1
|
||||
238 232 205 cornsilk2
|
||||
205 200 177 cornsilk3
|
||||
139 136 120 cornsilk4
|
||||
255 255 240 ivory1
|
||||
238 238 224 ivory2
|
||||
205 205 193 ivory3
|
||||
139 139 131 ivory4
|
||||
240 255 240 honeydew1
|
||||
224 238 224 honeydew2
|
||||
193 205 193 honeydew3
|
||||
131 139 131 honeydew4
|
||||
255 240 245 LavenderBlush1
|
||||
238 224 229 LavenderBlush2
|
||||
205 193 197 LavenderBlush3
|
||||
139 131 134 LavenderBlush4
|
||||
255 228 225 MistyRose1
|
||||
238 213 210 MistyRose2
|
||||
205 183 181 MistyRose3
|
||||
139 125 123 MistyRose4
|
||||
240 255 255 azure1
|
||||
224 238 238 azure2
|
||||
193 205 205 azure3
|
||||
131 139 139 azure4
|
||||
131 111 255 SlateBlue1
|
||||
122 103 238 SlateBlue2
|
||||
105 89 205 SlateBlue3
|
||||
71 60 139 SlateBlue4
|
||||
72 118 255 RoyalBlue1
|
||||
67 110 238 RoyalBlue2
|
||||
58 95 205 RoyalBlue3
|
||||
39 64 139 RoyalBlue4
|
||||
0 0 255 blue1
|
||||
0 0 238 blue2
|
||||
0 0 205 blue3
|
||||
0 0 139 blue4
|
||||
30 144 255 DodgerBlue1
|
||||
28 134 238 DodgerBlue2
|
||||
24 116 205 DodgerBlue3
|
||||
16 78 139 DodgerBlue4
|
||||
99 184 255 SteelBlue1
|
||||
92 172 238 SteelBlue2
|
||||
79 148 205 SteelBlue3
|
||||
54 100 139 SteelBlue4
|
||||
0 191 255 DeepSkyBlue1
|
||||
0 178 238 DeepSkyBlue2
|
||||
0 154 205 DeepSkyBlue3
|
||||
0 104 139 DeepSkyBlue4
|
||||
135 206 255 SkyBlue1
|
||||
126 192 238 SkyBlue2
|
||||
108 166 205 SkyBlue3
|
||||
74 112 139 SkyBlue4
|
||||
176 226 255 LightSkyBlue1
|
||||
164 211 238 LightSkyBlue2
|
||||
141 182 205 LightSkyBlue3
|
||||
96 123 139 LightSkyBlue4
|
||||
198 226 255 SlateGray1
|
||||
185 211 238 SlateGray2
|
||||
159 182 205 SlateGray3
|
||||
108 123 139 SlateGray4
|
||||
202 225 255 LightSteelBlue1
|
||||
188 210 238 LightSteelBlue2
|
||||
162 181 205 LightSteelBlue3
|
||||
110 123 139 LightSteelBlue4
|
||||
191 239 255 LightBlue1
|
||||
178 223 238 LightBlue2
|
||||
154 192 205 LightBlue3
|
||||
104 131 139 LightBlue4
|
||||
224 255 255 LightCyan1
|
||||
209 238 238 LightCyan2
|
||||
180 205 205 LightCyan3
|
||||
122 139 139 LightCyan4
|
||||
187 255 255 PaleTurquoise1
|
||||
174 238 238 PaleTurquoise2
|
||||
150 205 205 PaleTurquoise3
|
||||
102 139 139 PaleTurquoise4
|
||||
152 245 255 CadetBlue1
|
||||
142 229 238 CadetBlue2
|
||||
122 197 205 CadetBlue3
|
||||
83 134 139 CadetBlue4
|
||||
0 245 255 turquoise1
|
||||
0 229 238 turquoise2
|
||||
0 197 205 turquoise3
|
||||
0 134 139 turquoise4
|
||||
0 255 255 cyan1
|
||||
0 238 238 cyan2
|
||||
0 205 205 cyan3
|
||||
0 139 139 cyan4
|
||||
151 255 255 DarkSlateGray1
|
||||
141 238 238 DarkSlateGray2
|
||||
121 205 205 DarkSlateGray3
|
||||
82 139 139 DarkSlateGray4
|
||||
127 255 212 aquamarine1
|
||||
118 238 198 aquamarine2
|
||||
102 205 170 aquamarine3
|
||||
69 139 116 aquamarine4
|
||||
193 255 193 DarkSeaGreen1
|
||||
180 238 180 DarkSeaGreen2
|
||||
155 205 155 DarkSeaGreen3
|
||||
105 139 105 DarkSeaGreen4
|
||||
84 255 159 SeaGreen1
|
||||
78 238 148 SeaGreen2
|
||||
67 205 128 SeaGreen3
|
||||
46 139 87 SeaGreen4
|
||||
154 255 154 PaleGreen1
|
||||
144 238 144 PaleGreen2
|
||||
124 205 124 PaleGreen3
|
||||
84 139 84 PaleGreen4
|
||||
0 255 127 SpringGreen1
|
||||
0 238 118 SpringGreen2
|
||||
0 205 102 SpringGreen3
|
||||
0 139 69 SpringGreen4
|
||||
0 255 0 green1
|
||||
0 238 0 green2
|
||||
0 205 0 green3
|
||||
0 139 0 green4
|
||||
127 255 0 chartreuse1
|
||||
118 238 0 chartreuse2
|
||||
102 205 0 chartreuse3
|
||||
69 139 0 chartreuse4
|
||||
192 255 62 OliveDrab1
|
||||
179 238 58 OliveDrab2
|
||||
154 205 50 OliveDrab3
|
||||
105 139 34 OliveDrab4
|
||||
202 255 112 DarkOliveGreen1
|
||||
188 238 104 DarkOliveGreen2
|
||||
162 205 90 DarkOliveGreen3
|
||||
110 139 61 DarkOliveGreen4
|
||||
255 246 143 khaki1
|
||||
238 230 133 khaki2
|
||||
205 198 115 khaki3
|
||||
139 134 78 khaki4
|
||||
255 236 139 LightGoldenrod1
|
||||
238 220 130 LightGoldenrod2
|
||||
205 190 112 LightGoldenrod3
|
||||
139 129 76 LightGoldenrod4
|
||||
255 255 224 LightYellow1
|
||||
238 238 209 LightYellow2
|
||||
205 205 180 LightYellow3
|
||||
139 139 122 LightYellow4
|
||||
255 255 0 yellow1
|
||||
238 238 0 yellow2
|
||||
205 205 0 yellow3
|
||||
139 139 0 yellow4
|
||||
255 215 0 gold1
|
||||
238 201 0 gold2
|
||||
205 173 0 gold3
|
||||
139 117 0 gold4
|
||||
255 193 37 goldenrod1
|
||||
238 180 34 goldenrod2
|
||||
205 155 29 goldenrod3
|
||||
139 105 20 goldenrod4
|
||||
255 185 15 DarkGoldenrod1
|
||||
238 173 14 DarkGoldenrod2
|
||||
205 149 12 DarkGoldenrod3
|
||||
139 101 8 DarkGoldenrod4
|
||||
255 193 193 RosyBrown1
|
||||
238 180 180 RosyBrown2
|
||||
205 155 155 RosyBrown3
|
||||
139 105 105 RosyBrown4
|
||||
255 106 106 IndianRed1
|
||||
238 99 99 IndianRed2
|
||||
205 85 85 IndianRed3
|
||||
139 58 58 IndianRed4
|
||||
255 130 71 sienna1
|
||||
238 121 66 sienna2
|
||||
205 104 57 sienna3
|
||||
139 71 38 sienna4
|
||||
255 211 155 burlywood1
|
||||
238 197 145 burlywood2
|
||||
205 170 125 burlywood3
|
||||
139 115 85 burlywood4
|
||||
255 231 186 wheat1
|
||||
238 216 174 wheat2
|
||||
205 186 150 wheat3
|
||||
139 126 102 wheat4
|
||||
255 165 79 tan1
|
||||
238 154 73 tan2
|
||||
205 133 63 tan3
|
||||
139 90 43 tan4
|
||||
255 127 36 chocolate1
|
||||
238 118 33 chocolate2
|
||||
205 102 29 chocolate3
|
||||
139 69 19 chocolate4
|
||||
255 48 48 firebrick1
|
||||
238 44 44 firebrick2
|
||||
205 38 38 firebrick3
|
||||
139 26 26 firebrick4
|
||||
255 64 64 brown1
|
||||
238 59 59 brown2
|
||||
205 51 51 brown3
|
||||
139 35 35 brown4
|
||||
255 140 105 salmon1
|
||||
238 130 98 salmon2
|
||||
205 112 84 salmon3
|
||||
139 76 57 salmon4
|
||||
255 160 122 LightSalmon1
|
||||
238 149 114 LightSalmon2
|
||||
205 129 98 LightSalmon3
|
||||
139 87 66 LightSalmon4
|
||||
255 165 0 orange1
|
||||
238 154 0 orange2
|
||||
205 133 0 orange3
|
||||
139 90 0 orange4
|
||||
255 127 0 DarkOrange1
|
||||
238 118 0 DarkOrange2
|
||||
205 102 0 DarkOrange3
|
||||
139 69 0 DarkOrange4
|
||||
255 114 86 coral1
|
||||
238 106 80 coral2
|
||||
205 91 69 coral3
|
||||
139 62 47 coral4
|
||||
255 99 71 tomato1
|
||||
238 92 66 tomato2
|
||||
205 79 57 tomato3
|
||||
139 54 38 tomato4
|
||||
255 69 0 OrangeRed1
|
||||
238 64 0 OrangeRed2
|
||||
205 55 0 OrangeRed3
|
||||
139 37 0 OrangeRed4
|
||||
255 0 0 red1
|
||||
238 0 0 red2
|
||||
205 0 0 red3
|
||||
139 0 0 red4
|
||||
255 20 147 DeepPink1
|
||||
238 18 137 DeepPink2
|
||||
205 16 118 DeepPink3
|
||||
139 10 80 DeepPink4
|
||||
255 110 180 HotPink1
|
||||
238 106 167 HotPink2
|
||||
205 96 144 HotPink3
|
||||
139 58 98 HotPink4
|
||||
255 181 197 pink1
|
||||
238 169 184 pink2
|
||||
205 145 158 pink3
|
||||
139 99 108 pink4
|
||||
255 174 185 LightPink1
|
||||
238 162 173 LightPink2
|
||||
205 140 149 LightPink3
|
||||
139 95 101 LightPink4
|
||||
255 130 171 PaleVioletRed1
|
||||
238 121 159 PaleVioletRed2
|
||||
205 104 137 PaleVioletRed3
|
||||
139 71 93 PaleVioletRed4
|
||||
255 52 179 maroon1
|
||||
238 48 167 maroon2
|
||||
205 41 144 maroon3
|
||||
139 28 98 maroon4
|
||||
255 62 150 VioletRed1
|
||||
238 58 140 VioletRed2
|
||||
205 50 120 VioletRed3
|
||||
139 34 82 VioletRed4
|
||||
255 0 255 magenta1
|
||||
238 0 238 magenta2
|
||||
205 0 205 magenta3
|
||||
139 0 139 magenta4
|
||||
255 131 250 orchid1
|
||||
238 122 233 orchid2
|
||||
205 105 201 orchid3
|
||||
139 71 137 orchid4
|
||||
255 187 255 plum1
|
||||
238 174 238 plum2
|
||||
205 150 205 plum3
|
||||
139 102 139 plum4
|
||||
224 102 255 MediumOrchid1
|
||||
209 95 238 MediumOrchid2
|
||||
180 82 205 MediumOrchid3
|
||||
122 55 139 MediumOrchid4
|
||||
191 62 255 DarkOrchid1
|
||||
178 58 238 DarkOrchid2
|
||||
154 50 205 DarkOrchid3
|
||||
104 34 139 DarkOrchid4
|
||||
155 48 255 purple1
|
||||
145 44 238 purple2
|
||||
125 38 205 purple3
|
||||
85 26 139 purple4
|
||||
171 130 255 MediumPurple1
|
||||
159 121 238 MediumPurple2
|
||||
137 104 205 MediumPurple3
|
||||
93 71 139 MediumPurple4
|
||||
255 225 255 thistle1
|
||||
238 210 238 thistle2
|
||||
205 181 205 thistle3
|
||||
139 123 139 thistle4
|
||||
0 0 0 gray0
|
||||
0 0 0 grey0
|
||||
3 3 3 gray1
|
||||
3 3 3 grey1
|
||||
5 5 5 gray2
|
||||
5 5 5 grey2
|
||||
8 8 8 gray3
|
||||
8 8 8 grey3
|
||||
10 10 10 gray4
|
||||
10 10 10 grey4
|
||||
13 13 13 gray5
|
||||
13 13 13 grey5
|
||||
15 15 15 gray6
|
||||
15 15 15 grey6
|
||||
18 18 18 gray7
|
||||
18 18 18 grey7
|
||||
20 20 20 gray8
|
||||
20 20 20 grey8
|
||||
23 23 23 gray9
|
||||
23 23 23 grey9
|
||||
26 26 26 gray10
|
||||
26 26 26 grey10
|
||||
28 28 28 gray11
|
||||
28 28 28 grey11
|
||||
31 31 31 gray12
|
||||
31 31 31 grey12
|
||||
33 33 33 gray13
|
||||
33 33 33 grey13
|
||||
36 36 36 gray14
|
||||
36 36 36 grey14
|
||||
38 38 38 gray15
|
||||
38 38 38 grey15
|
||||
41 41 41 gray16
|
||||
41 41 41 grey16
|
||||
43 43 43 gray17
|
||||
43 43 43 grey17
|
||||
46 46 46 gray18
|
||||
46 46 46 grey18
|
||||
48 48 48 gray19
|
||||
48 48 48 grey19
|
||||
51 51 51 gray20
|
||||
51 51 51 grey20
|
||||
54 54 54 gray21
|
||||
54 54 54 grey21
|
||||
56 56 56 gray22
|
||||
56 56 56 grey22
|
||||
59 59 59 gray23
|
||||
59 59 59 grey23
|
||||
61 61 61 gray24
|
||||
61 61 61 grey24
|
||||
64 64 64 gray25
|
||||
64 64 64 grey25
|
||||
66 66 66 gray26
|
||||
66 66 66 grey26
|
||||
69 69 69 gray27
|
||||
69 69 69 grey27
|
||||
71 71 71 gray28
|
||||
71 71 71 grey28
|
||||
74 74 74 gray29
|
||||
74 74 74 grey29
|
||||
77 77 77 gray30
|
||||
77 77 77 grey30
|
||||
79 79 79 gray31
|
||||
79 79 79 grey31
|
||||
82 82 82 gray32
|
||||
82 82 82 grey32
|
||||
84 84 84 gray33
|
||||
84 84 84 grey33
|
||||
87 87 87 gray34
|
||||
87 87 87 grey34
|
||||
89 89 89 gray35
|
||||
89 89 89 grey35
|
||||
92 92 92 gray36
|
||||
92 92 92 grey36
|
||||
94 94 94 gray37
|
||||
94 94 94 grey37
|
||||
97 97 97 gray38
|
||||
97 97 97 grey38
|
||||
99 99 99 gray39
|
||||
99 99 99 grey39
|
||||
102 102 102 gray40
|
||||
102 102 102 grey40
|
||||
105 105 105 gray41
|
||||
105 105 105 grey41
|
||||
107 107 107 gray42
|
||||
107 107 107 grey42
|
||||
110 110 110 gray43
|
||||
110 110 110 grey43
|
||||
112 112 112 gray44
|
||||
112 112 112 grey44
|
||||
115 115 115 gray45
|
||||
115 115 115 grey45
|
||||
117 117 117 gray46
|
||||
117 117 117 grey46
|
||||
120 120 120 gray47
|
||||
120 120 120 grey47
|
||||
122 122 122 gray48
|
||||
122 122 122 grey48
|
||||
125 125 125 gray49
|
||||
125 125 125 grey49
|
||||
127 127 127 gray50
|
||||
127 127 127 grey50
|
||||
130 130 130 gray51
|
||||
130 130 130 grey51
|
||||
133 133 133 gray52
|
||||
133 133 133 grey52
|
||||
135 135 135 gray53
|
||||
135 135 135 grey53
|
||||
138 138 138 gray54
|
||||
138 138 138 grey54
|
||||
140 140 140 gray55
|
||||
140 140 140 grey55
|
||||
143 143 143 gray56
|
||||
143 143 143 grey56
|
||||
145 145 145 gray57
|
||||
145 145 145 grey57
|
||||
148 148 148 gray58
|
||||
148 148 148 grey58
|
||||
150 150 150 gray59
|
||||
150 150 150 grey59
|
||||
153 153 153 gray60
|
||||
153 153 153 grey60
|
||||
156 156 156 gray61
|
||||
156 156 156 grey61
|
||||
158 158 158 gray62
|
||||
158 158 158 grey62
|
||||
161 161 161 gray63
|
||||
161 161 161 grey63
|
||||
163 163 163 gray64
|
||||
163 163 163 grey64
|
||||
166 166 166 gray65
|
||||
166 166 166 grey65
|
||||
168 168 168 gray66
|
||||
168 168 168 grey66
|
||||
171 171 171 gray67
|
||||
171 171 171 grey67
|
||||
173 173 173 gray68
|
||||
173 173 173 grey68
|
||||
176 176 176 gray69
|
||||
176 176 176 grey69
|
||||
179 179 179 gray70
|
||||
179 179 179 grey70
|
||||
181 181 181 gray71
|
||||
181 181 181 grey71
|
||||
184 184 184 gray72
|
||||
184 184 184 grey72
|
||||
186 186 186 gray73
|
||||
186 186 186 grey73
|
||||
189 189 189 gray74
|
||||
189 189 189 grey74
|
||||
191 191 191 gray75
|
||||
191 191 191 grey75
|
||||
194 194 194 gray76
|
||||
194 194 194 grey76
|
||||
196 196 196 gray77
|
||||
196 196 196 grey77
|
||||
199 199 199 gray78
|
||||
199 199 199 grey78
|
||||
201 201 201 gray79
|
||||
201 201 201 grey79
|
||||
204 204 204 gray80
|
||||
204 204 204 grey80
|
||||
207 207 207 gray81
|
||||
207 207 207 grey81
|
||||
209 209 209 gray82
|
||||
209 209 209 grey82
|
||||
212 212 212 gray83
|
||||
212 212 212 grey83
|
||||
214 214 214 gray84
|
||||
214 214 214 grey84
|
||||
217 217 217 gray85
|
||||
217 217 217 grey85
|
||||
219 219 219 gray86
|
||||
219 219 219 grey86
|
||||
222 222 222 gray87
|
||||
222 222 222 grey87
|
||||
224 224 224 gray88
|
||||
224 224 224 grey88
|
||||
227 227 227 gray89
|
||||
227 227 227 grey89
|
||||
229 229 229 gray90
|
||||
229 229 229 grey90
|
||||
232 232 232 gray91
|
||||
232 232 232 grey91
|
||||
235 235 235 gray92
|
||||
235 235 235 grey92
|
||||
237 237 237 gray93
|
||||
237 237 237 grey93
|
||||
240 240 240 gray94
|
||||
240 240 240 grey94
|
||||
242 242 242 gray95
|
||||
242 242 242 grey95
|
||||
245 245 245 gray96
|
||||
245 245 245 grey96
|
||||
247 247 247 gray97
|
||||
247 247 247 grey97
|
||||
250 250 250 gray98
|
||||
250 250 250 grey98
|
||||
252 252 252 gray99
|
||||
252 252 252 grey99
|
||||
255 255 255 gray100
|
||||
255 255 255 grey100
|
||||
169 169 169 dark grey
|
||||
169 169 169 DarkGrey
|
||||
169 169 169 dark gray
|
||||
169 169 169 DarkGray
|
||||
0 0 139 dark blue
|
||||
0 0 139 DarkBlue
|
||||
0 139 139 dark cyan
|
||||
0 139 139 DarkCyan
|
||||
139 0 139 dark magenta
|
||||
139 0 139 DarkMagenta
|
||||
139 0 0 dark red
|
||||
139 0 0 DarkRed
|
||||
144 238 144 light green
|
||||
144 238 144 LightGreen
|
||||
|
|
@ -0,0 +1 @@
|
|||
A utility to look up colors in the X11 rgb.txt color database
|
||||
|
|
@ -71,6 +71,9 @@ C: <nil> nil
|
|||
[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
|
||||
[ ] [ 3 [ _ ] undo ] unit-test
|
||||
|
||||
[ 2.0 ] [ 2 3 ^ [ 3 ^ ] undo ] unit-test
|
||||
[ 3.0 ] [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
|
||||
|
||||
[ { 1 } ] [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
|
||||
[ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
|
||||
[ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
|
||||
|
|
@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
|
|||
continuations debugger classes.tuple namespaces make vectors
|
||||
bit-arrays byte-arrays strings sbufs math.functions macros
|
||||
sequences.private combinators mirrors splitting
|
||||
combinators.short-circuit fry words.symbol ;
|
||||
combinators.short-circuit fry words.symbol generalizations ;
|
||||
RENAME: _ fry => __
|
||||
IN: inverse
|
||||
|
||||
|
|
@ -163,7 +163,7 @@ ERROR: missing-literal ;
|
|||
\ - [ + ] [ - ] define-math-inverse
|
||||
\ * [ / ] [ / ] define-math-inverse
|
||||
\ / [ * ] [ / ] define-math-inverse
|
||||
\ ^ [ recip ^ ] [ [ log ] bi@ / ] define-math-inverse
|
||||
\ ^ [ recip ^ ] [ swap [ log ] bi@ / ] define-math-inverse
|
||||
|
||||
\ ? 2 [
|
||||
[ assert-literal ] bi@
|
||||
|
|
@ -199,6 +199,7 @@ DEFER: _
|
|||
\ 2array [ 2 assure-length first2 ] define-inverse
|
||||
\ 3array [ 3 assure-length first3 ] define-inverse
|
||||
\ 4array [ 4 assure-length first4 ] define-inverse
|
||||
\ narray 1 [ [ firstn ] curry ] define-pop-inverse
|
||||
|
||||
\ first [ 1array ] define-inverse
|
||||
\ first2 [ 2array ] define-inverse
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
USING: io.launcher tools.test calendar accessors environment
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations eval
|
||||
io.files.temp io.directories io.pathnames ;
|
||||
io.files.temp io.directories io.pathnames splitting ;
|
||||
IN: io.launcher.windows.nt.tests
|
||||
|
||||
[ ] [
|
||||
|
|
@ -23,9 +23,12 @@ IN: io.launcher.windows.nt.tests
|
|||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
: console-vm ( -- path )
|
||||
vm ".exe" ?tail [ ".com" append ] when ;
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-quiet" "-run=hello-world" 3array >>command
|
||||
console-vm "-quiet" "-run=hello-world" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
|
@ -36,7 +39,7 @@ IN: io.launcher.windows.nt.tests
|
|||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-run=listener" 2array >>command
|
||||
console-vm "-run=listener" 2array >>command
|
||||
+closed+ >>stdin
|
||||
try-process
|
||||
] unit-test
|
||||
|
|
@ -47,7 +50,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
console-vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
"err.txt" temp-file >>stderr
|
||||
try-process
|
||||
|
|
@ -65,7 +68,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
console-vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
+stdout+ >>stderr
|
||||
try-process
|
||||
|
|
@ -79,7 +82,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ "output" ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
console-vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
ascii <process-reader> lines first
|
||||
] with-directory
|
||||
|
|
@ -92,7 +95,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ t ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
console-vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
|
|
@ -102,7 +105,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ t ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
console-vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
os-envs >>environment
|
||||
ascii <process-reader> contents
|
||||
|
|
@ -114,7 +117,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ "B" ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
console-vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
|
@ -125,7 +128,7 @@ IN: io.launcher.windows.nt.tests
|
|||
[ f ] [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
console-vm "-script" "env.factor" 3array >>command
|
||||
{ { "USERPROFILE" "XXX" } } >>environment
|
||||
+prepend-environment+ >>environment-mode
|
||||
ascii <process-reader> contents
|
||||
|
|
@ -151,7 +154,7 @@ IN: io.launcher.windows.nt.tests
|
|||
2 [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "append.factor" 3array >>command
|
||||
console-vm "-script" "append.factor" 3array >>command
|
||||
"append-test" temp-file <appender> >>stdout
|
||||
try-process
|
||||
] with-directory
|
||||
|
|
|
|||
|
|
@ -33,3 +33,10 @@ IN: math.rectangles.tests
|
|||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
[ T{ rect f { 10 20 } { 20 20 } } ] [
|
||||
{
|
||||
{ 20 20 }
|
||||
{ 10 40 }
|
||||
{ 30 30 }
|
||||
} rect-containing
|
||||
] unit-test
|
||||
|
|
@ -44,3 +44,7 @@ M: rect contains-point?
|
|||
|
||||
: rect-union ( rect1 rect2 -- newrect )
|
||||
(rect-union) <extent-rect> ;
|
||||
|
||||
: rect-containing ( points -- rect )
|
||||
[ vsupremum ] [ vinfimum ] bi
|
||||
[ nip ] [ v- ] 2bi <rect> ;
|
||||
|
|
|
|||
|
|
@ -19,6 +19,9 @@ IN: math.vectors
|
|||
: vmax ( u v -- w ) [ max ] 2map ;
|
||||
: vmin ( u v -- w ) [ min ] 2map ;
|
||||
|
||||
: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ;
|
||||
: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ;
|
||||
|
||||
: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
|
||||
: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
|
||||
: norm ( v -- x ) norm-sq sqrt ;
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ ERROR: roman-range-error n ;
|
|||
] 2each drop ;
|
||||
|
||||
: (roman>) ( seq -- n )
|
||||
dup [ roman>n ] map swap all-eq? [
|
||||
[ [ roman>n ] map ] [ all-eq? ] bi [
|
||||
sum
|
||||
] [
|
||||
first2 swap -
|
||||
|
|
|
|||
|
|
@ -113,14 +113,18 @@ M: server-error error.
|
|||
"Description: " write dup message>> print
|
||||
"Tag: " write tag>> xml>string print ;
|
||||
|
||||
PROCESS: xml>item ( tag -- object )
|
||||
TAGS: xml>item ( tag -- object )
|
||||
|
||||
TAG: string xml>item
|
||||
children>string ;
|
||||
|
||||
TAG: i4/int/double xml>item
|
||||
: children>number ( tag -- n )
|
||||
children>string string>number ;
|
||||
|
||||
TAG: i4 xml>item children>number ;
|
||||
TAG: int xml>item children>number ;
|
||||
TAG: double xml>item children>number ;
|
||||
|
||||
TAG: boolean xml>item
|
||||
dup children>string {
|
||||
{ [ dup "1" = ] [ 2drop t ] }
|
||||
|
|
@ -174,5 +178,5 @@ TAG: array xml>item
|
|||
! This needs to do something in the event of an error
|
||||
[ send-rpc ] dip http-post nip string>xml receive-rpc ;
|
||||
|
||||
: invoke-method ( params method url -- )
|
||||
: invoke-method ( params method url -- response )
|
||||
[ swap <rpc-method> ] dip post-rpc ;
|
||||
|
|
|
|||
|
|
@ -6,20 +6,20 @@ IN: xml.dispatch
|
|||
ABOUT: "xml.dispatch"
|
||||
|
||||
ARTICLE: "xml.dispatch" "Dispatch on XML tag names"
|
||||
"Two parsing words define a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
|
||||
{ $subsection POSTPONE: PROCESS: }
|
||||
"The " { $link "xml.dispatch" } " vocabulary defines a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
|
||||
{ $subsection POSTPONE: TAGS: }
|
||||
"and to define a new 'method' for this word, use"
|
||||
{ $subsection POSTPONE: TAG: } ;
|
||||
|
||||
HELP: PROCESS:
|
||||
{ $syntax "PROCESS: word" }
|
||||
HELP: TAGS:
|
||||
{ $syntax "TAGS: word" }
|
||||
{ $values { "word" "a new word to define" } }
|
||||
{ $description "creates a new word to process XML tags" }
|
||||
{ $description "Creates a new word to which dispatches on XML tag names." }
|
||||
{ $see-also POSTPONE: TAG: } ;
|
||||
|
||||
HELP: TAG:
|
||||
{ $syntax "TAG: tag word definition... ;" }
|
||||
{ $values { "tag" "an xml tag name" } { "word" "an XML process" } }
|
||||
{ $description "defines what a process should do when it encounters a specific tag" }
|
||||
{ $examples { $code "PROCESS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
|
||||
{ $see-also POSTPONE: PROCESS: } ;
|
||||
{ $values { "tag" "an XML tag name" } { "word" "an XML process" } }
|
||||
{ $description "Defines a 'method' on a word created with " { $link POSTPONE: TAGS: } ". It determines what such a word should do for an argument that is has the given name." }
|
||||
{ $examples { $code "TAGS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
|
||||
{ $see-also POSTPONE: TAGS: } ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: xml io kernel math sequences strings xml.utilities
|
|||
tools.test math.parser xml.dispatch ;
|
||||
IN: xml.dispatch.tests
|
||||
|
||||
PROCESS: calculate ( tag -- n )
|
||||
TAGS: calculate ( tag -- n )
|
||||
|
||||
: calc-2children ( tag -- n n )
|
||||
children-tags first2 [ calculate ] dip calculate ;
|
||||
|
|
@ -29,3 +29,5 @@ TAG: neg calculate
|
|||
"<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
|
||||
calc-arith
|
||||
] unit-test
|
||||
|
||||
\ calc-arith must-infer
|
||||
|
|
|
|||
|
|
@ -1,27 +1,32 @@
|
|||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: words assocs kernel accessors parser sequences summary
|
||||
lexer splitting fry ;
|
||||
lexer splitting fry combinators locals ;
|
||||
IN: xml.dispatch
|
||||
|
||||
TUPLE: process-missing process tag ;
|
||||
M: process-missing summary
|
||||
drop "Tag not implemented on process" ;
|
||||
TUPLE: no-tag name word ;
|
||||
M: no-tag summary
|
||||
drop "The tag-dispatching word has no method for the given tag name" ;
|
||||
|
||||
: run-process ( tag word -- )
|
||||
2dup "xtable" word-prop
|
||||
[ dup main>> ] dip at* [ 2nip call ] [
|
||||
drop \ process-missing boa throw
|
||||
] if ;
|
||||
<PRIVATE
|
||||
|
||||
: PROCESS:
|
||||
: compile-tags ( word xtable -- quot )
|
||||
>alist swap '[ _ no-tag boa throw ] suffix
|
||||
'[ dup main>> _ case ] ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-tags ( word -- )
|
||||
dup dup "xtable" word-prop compile-tags define ;
|
||||
|
||||
:: define-tag ( string word quot -- )
|
||||
quot string word "xtable" word-prop set-at
|
||||
word define-tags ;
|
||||
|
||||
: TAGS:
|
||||
CREATE
|
||||
dup H{ } clone "xtable" set-word-prop
|
||||
dup '[ _ run-process ] define ; parsing
|
||||
[ H{ } clone "xtable" set-word-prop ]
|
||||
[ define-tags ] bi ; parsing
|
||||
|
||||
: TAG:
|
||||
scan scan-word
|
||||
parse-definition
|
||||
swap "xtable" word-prop
|
||||
rot "/" split [ [ 2dup ] dip swap set-at ] each 2drop ;
|
||||
parsing
|
||||
scan scan-word parse-definition define-tag ; parsing
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ IN: xml.literals.tests
|
|||
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
|
||||
|
||||
\ <XML must-infer
|
||||
[ { } "" interpolate-xml ] must-infer
|
||||
[ [XML <-> XML] ] must-infer
|
||||
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
|
||||
|
||||
[ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
|
||||
|
|
@ -66,3 +66,37 @@ IN: xml.literals.tests
|
|||
[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
|
||||
|
||||
[ "" ] [ [XML XML] concat ] unit-test
|
||||
|
||||
USE: inverse
|
||||
|
||||
[ "foo" ] [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
|
||||
[ "foo" ] [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
|
||||
[ "foo" "baz" ] [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test
|
||||
|
||||
: dispatch ( xml -- string )
|
||||
{
|
||||
{ [ [XML <a><-></a> XML] ] [ "a" prepend ] }
|
||||
{ [ [XML <b><-></b> XML] ] [ "b" prepend ] }
|
||||
{ [ [XML <b val='yes'/> XML] ] [ "byes" ] }
|
||||
{ [ [XML <b val=<->/> XML] ] [ "bno" prepend ] }
|
||||
} switch ;
|
||||
|
||||
[ "apple" ] [ [XML <a>pple</a> XML] dispatch ] unit-test
|
||||
[ "banana" ] [ [XML <b>anana</b> XML] dispatch ] unit-test
|
||||
[ "byes" ] [ [XML <b val="yes"/> XML] dispatch ] unit-test
|
||||
[ "bnowhere" ] [ [XML <b val="where"/> XML] dispatch ] unit-test
|
||||
[ "baboon" ] [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
|
||||
[ "apple" ] [ <XML <a>pple</a> XML> dispatch ] unit-test
|
||||
[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch ] unit-test
|
||||
|
||||
: dispatch-doc ( xml -- string )
|
||||
{
|
||||
{ [ <XML <a><-></a> XML> ] [ "a" prepend ] }
|
||||
{ [ <XML <b><-></b> XML> ] [ "b" prepend ] }
|
||||
{ [ <XML <b val='yes'/> XML> ] [ "byes" ] }
|
||||
{ [ <XML <b val=<->/> XML> ] [ "bno" prepend ] }
|
||||
} switch ;
|
||||
|
||||
[ "apple" ] [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
|
||||
[ "apple" ] [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
|
||||
[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,11 +3,34 @@
|
|||
USING: xml xml.state kernel sequences fry assocs xml.data
|
||||
accessors strings make multiline parser namespaces macros
|
||||
sequences.deep generalizations words combinators
|
||||
math present arrays unicode.categories ;
|
||||
math present arrays unicode.categories locals.backend
|
||||
quotations ;
|
||||
IN: xml.literals
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: each-attrs ( attrs quot -- )
|
||||
[ values [ interpolated? ] filter ] dip each ; inline
|
||||
|
||||
: (each-interpolated) ( item quot: ( interpolated -- ) -- )
|
||||
{
|
||||
{ [ over interpolated? ] [ call ] }
|
||||
{ [ over tag? ] [ [ attrs>> ] dip each-attrs ] }
|
||||
{ [ over attrs? ] [ each-attrs ] }
|
||||
{ [ over xml? ] [ [ body>> ] dip (each-interpolated) ] }
|
||||
[ 2drop ]
|
||||
} cond ; inline recursive
|
||||
|
||||
: each-interpolated ( xml quot -- )
|
||||
'[ _ (each-interpolated) ] deep-each ; inline
|
||||
|
||||
: has-interpolated? ( xml -- ? )
|
||||
! If this becomes a performance problem, it can be improved
|
||||
f swap [ 2drop t ] each-interpolated ;
|
||||
|
||||
: when-interpolated ( xml quot -- genquot )
|
||||
[ dup has-interpolated? ] dip [ '[ _ swap ] ] if ; inline
|
||||
|
||||
: string>chunk ( string -- chunk )
|
||||
t interpolating? [ string>xml-chunk ] with-variable ;
|
||||
|
||||
|
|
@ -16,17 +39,34 @@ IN: xml.literals
|
|||
|
||||
DEFER: interpolate-sequence
|
||||
|
||||
: interpolate-attrs ( table attrs -- attrs )
|
||||
swap '[
|
||||
dup interpolated?
|
||||
[ var>> _ at dup [ present ] when ] when
|
||||
] assoc-map [ nip ] assoc-filter ;
|
||||
: get-interpolated ( interpolated -- quot )
|
||||
var>> '[ [ _ swap at ] keep ] ;
|
||||
|
||||
: interpolate-tag ( table tag -- tag )
|
||||
[ nip name>> ]
|
||||
[ attrs>> interpolate-attrs ]
|
||||
[ children>> [ interpolate-sequence ] [ drop f ] if* ] 2tri
|
||||
<tag> ;
|
||||
: ?present ( object -- string )
|
||||
dup [ present ] when ;
|
||||
|
||||
: interpolate-attr ( key value -- quot )
|
||||
dup interpolated?
|
||||
[ get-interpolated '[ _ swap @ [ ?present 2array ] dip ] ]
|
||||
[ 2array '[ _ swap ] ] if ;
|
||||
|
||||
: filter-nulls ( assoc -- newassoc )
|
||||
[ nip ] assoc-filter ;
|
||||
|
||||
: interpolate-attrs ( attrs -- quot )
|
||||
[
|
||||
[ [ interpolate-attr ] { } assoc>map [ ] join ]
|
||||
[ assoc-size ] bi
|
||||
'[ @ _ swap [ narray filter-nulls <attrs> ] dip ]
|
||||
] when-interpolated ;
|
||||
|
||||
: interpolate-tag ( tag -- quot )
|
||||
[
|
||||
[ name>> ]
|
||||
[ attrs>> interpolate-attrs ]
|
||||
[ children>> interpolate-sequence ] tri
|
||||
'[ _ swap @ @ [ <tag> ] dip ]
|
||||
] when-interpolated ;
|
||||
|
||||
GENERIC: push-item ( item -- )
|
||||
M: string push-item , ;
|
||||
|
|
@ -37,30 +77,33 @@ M: sequence push-item
|
|||
M: number push-item present , ;
|
||||
M: xml-chunk push-item % ;
|
||||
|
||||
GENERIC: interpolate-item ( table item -- )
|
||||
M: object interpolate-item nip , ;
|
||||
M: tag interpolate-item interpolate-tag , ;
|
||||
M: interpolated interpolate-item
|
||||
var>> swap at push-item ;
|
||||
: concat-interpolate ( array -- newarray )
|
||||
[ [ push-item ] each ] { } make ;
|
||||
|
||||
: interpolate-sequence ( table seq -- seq )
|
||||
[ [ interpolate-item ] with each ] { } make ;
|
||||
GENERIC: interpolate-item ( item -- quot )
|
||||
M: object interpolate-item [ swap ] curry ;
|
||||
M: tag interpolate-item interpolate-tag ;
|
||||
M: interpolated interpolate-item get-interpolated ;
|
||||
|
||||
: interpolate-xml-doc ( table xml -- xml )
|
||||
(clone) [ interpolate-tag ] change-body ;
|
||||
: interpolate-sequence ( seq -- quot )
|
||||
[
|
||||
[ [ interpolate-item ] map concat ]
|
||||
[ length ] bi
|
||||
'[ @ _ swap [ narray concat-interpolate ] dip ]
|
||||
] when-interpolated ;
|
||||
|
||||
: (each-interpolated) ( item quot: ( interpolated -- ) -- )
|
||||
{
|
||||
{ [ over interpolated? ] [ call ] }
|
||||
{ [ over tag? ] [
|
||||
[ attrs>> values [ interpolated? ] filter ] dip each
|
||||
] }
|
||||
{ [ over xml? ] [ [ body>> ] dip (each-interpolated) ] }
|
||||
[ 2drop ]
|
||||
} cond ; inline recursive
|
||||
GENERIC: [interpolate-xml] ( xml -- quot )
|
||||
|
||||
: each-interpolated ( xml quot -- )
|
||||
'[ _ (each-interpolated) ] deep-each ; inline
|
||||
M: xml [interpolate-xml]
|
||||
dup body>> interpolate-tag
|
||||
'[ _ (clone) swap @ drop >>body ] ;
|
||||
|
||||
M: xml-chunk [interpolate-xml]
|
||||
interpolate-sequence
|
||||
'[ @ drop <xml-chunk> ] ;
|
||||
|
||||
MACRO: interpolate-xml ( xml -- quot )
|
||||
[interpolate-xml] ;
|
||||
|
||||
: number<-> ( doc -- dup )
|
||||
0 over [
|
||||
|
|
@ -69,14 +112,6 @@ M: interpolated interpolate-item
|
|||
] unless drop
|
||||
] each-interpolated drop ;
|
||||
|
||||
GENERIC: interpolate-xml ( table xml -- xml )
|
||||
|
||||
M: xml interpolate-xml
|
||||
interpolate-xml-doc ;
|
||||
|
||||
M: xml-chunk interpolate-xml
|
||||
interpolate-sequence <xml-chunk> ;
|
||||
|
||||
: >search-hash ( seq -- hash )
|
||||
[ dup search ] H{ } map>assoc ;
|
||||
|
||||
|
|
@ -107,3 +142,73 @@ PRIVATE>
|
|||
|
||||
: [XML
|
||||
"XML]" [ string>chunk ] parse-def ; parsing
|
||||
|
||||
USING: inverse sorting fry combinators.short-circuit ;
|
||||
|
||||
: remove-blanks ( seq -- newseq )
|
||||
[ { [ string? not ] [ [ blank? ] all? not ] } 1|| ] filter ;
|
||||
|
||||
GENERIC: >xml ( xml -- tag )
|
||||
M: xml >xml body>> ;
|
||||
M: tag >xml ;
|
||||
M: xml-chunk >xml
|
||||
remove-blanks
|
||||
[ length 1 =/fail ]
|
||||
[ first dup tag? [ fail ] unless ] bi ;
|
||||
M: object >xml fail ;
|
||||
|
||||
: 1chunk ( object -- xml-chunk )
|
||||
1array <xml-chunk> ;
|
||||
|
||||
GENERIC: >xml-chunk ( xml -- chunk )
|
||||
M: xml >xml-chunk body>> 1chunk ;
|
||||
M: xml-chunk >xml-chunk ;
|
||||
M: object >xml-chunk 1chunk ;
|
||||
|
||||
GENERIC: [undo-xml] ( xml -- quot )
|
||||
|
||||
M: xml [undo-xml]
|
||||
body>> [undo-xml] '[ >xml @ ] ;
|
||||
|
||||
M: xml-chunk [undo-xml]
|
||||
seq>> [undo-xml] '[ >xml-chunk @ ] ;
|
||||
|
||||
: undo-attrs ( attrs -- quot: ( attrs -- ) )
|
||||
[
|
||||
[ main>> ] dip dup interpolated?
|
||||
[ var>> '[ _ attr _ set ] ]
|
||||
[ '[ _ attr _ =/fail ] ] if
|
||||
] { } assoc>map '[ _ cleave ] ;
|
||||
|
||||
M: tag [undo-xml] ( tag -- quot: ( tag -- ) )
|
||||
{
|
||||
[ name>> main>> '[ name>> main>> _ =/fail ] ]
|
||||
[ attrs>> undo-attrs ]
|
||||
[ children>> [undo-xml] '[ children>> @ ] ]
|
||||
} cleave '[ _ _ _ tri ] ;
|
||||
|
||||
: firstn-strong ( seq n -- ... )
|
||||
[ swap length =/fail ]
|
||||
[ firstn ] 2bi ; inline
|
||||
|
||||
M: sequence [undo-xml] ( sequence -- quot: ( seq -- ) )
|
||||
remove-blanks [ length ] [ [ [undo-xml] ] { } map-as ] bi
|
||||
'[ remove-blanks _ firstn-strong _ spread ] ;
|
||||
|
||||
M: string [undo-xml] ( string -- quot: ( string -- ) )
|
||||
'[ _ =/fail ] ;
|
||||
|
||||
M: xml-data [undo-xml] ( datum -- quot: ( datum -- ) )
|
||||
'[ _ =/fail ] ;
|
||||
|
||||
M: interpolated [undo-xml]
|
||||
var>> '[ _ set ] ;
|
||||
|
||||
: >enum ( assoc -- enum )
|
||||
! Assumes keys are 0..n
|
||||
>alist sort-keys values <enum> ;
|
||||
|
||||
: undo-xml ( xml -- quot )
|
||||
[undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
|
||||
|
||||
\ interpolate-xml 1 [ undo-xml ] define-pop-inverse
|
||||
|
|
|
|||
|
|
@ -67,3 +67,4 @@ SYMBOL: xml-file
|
|||
[ "x" "<" ] [ "<x value='<'/>" string>xml [ name>> main>> ] [ "value" attr ] bi ] unit-test
|
||||
[ "foo" ] [ "<!DOCTYPE foo [<!ENTITY bar 'foo'>]><x>&bar;</x>" string>xml children>string ] unit-test
|
||||
[ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test
|
||||
[ "1.1" ] [ "<?xml version='1.1'?><x/>" string>xml prolog>> version>> ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: xml.data xml.writer tools.test fry xml kernel multiline
|
||||
xml.writer.private io.streams.string xml.utilities sequences ;
|
||||
xml.writer.private io.streams.string xml.utilities sequences
|
||||
io.encodings.utf8 io.files accessors io.directories ;
|
||||
IN: xml.writer.tests
|
||||
|
||||
\ write-xml must-infer
|
||||
|
|
@ -59,3 +60,9 @@ IN: xml.writer.tests
|
|||
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<foo>\n bar\n</foo>" ]
|
||||
[ "<foo> bar </foo>" string>xml pprint-xml>string ] unit-test
|
||||
[ "<foo'>" ] [ "<foo'>" <unescaped> xml>string ] unit-test
|
||||
|
||||
: test-file "resource:basis/xml/writer/test.xml" ;
|
||||
|
||||
[ ] [ "<?xml version='1.0' encoding='UTF-16BE'?><x/>" string>xml test-file utf8 [ write-xml ] with-file-writer ] unit-test
|
||||
[ "x" ] [ test-file file>xml body>> name>> main>> ] unit-test
|
||||
[ ] [ test-file delete-file ] unit-test
|
||||
|
|
|
|||
|
|
@ -164,7 +164,7 @@ M: sequence write-xml
|
|||
M: prolog write-xml
|
||||
"<?xml version=" write
|
||||
[ version>> write-quoted ]
|
||||
[ " encoding=" write encoding>> write-quoted ]
|
||||
[ drop " encoding=\"UTF-8\"" write ]
|
||||
[ standalone>> [ " standalone=\"yes\"" write ] when ] tri
|
||||
"?>" write ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors arrays io io.encodings.binary io.files
|
|||
io.streams.string kernel namespaces sequences strings io.encodings.utf8
|
||||
xml.data xml.errors xml.elements ascii xml.entities
|
||||
xml.writer xml.state xml.autoencoding assocs xml.tokenize
|
||||
combinators.short-circuit xml.name ;
|
||||
combinators.short-circuit xml.name splitting ;
|
||||
IN: xml
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -25,7 +25,7 @@ M: object process add-child ;
|
|||
M: prolog process
|
||||
xml-stack get
|
||||
{ V{ { f V{ "" } } } V{ { f V{ } } } } member?
|
||||
[ bad-prolog ] unless drop ;
|
||||
[ bad-prolog ] unless add-child ;
|
||||
|
||||
: before-main? ( -- ? )
|
||||
xml-stack get {
|
||||
|
|
@ -82,14 +82,23 @@ M: closer process
|
|||
! this does *not* affect the contents of the stack
|
||||
[ notags ] unless* ;
|
||||
|
||||
: ?first ( seq -- elt/f ) 0 swap ?nth ;
|
||||
|
||||
: get-prolog ( seq -- prolog )
|
||||
first dup prolog? [ drop default-prolog ] unless ;
|
||||
{ "" } ?head drop
|
||||
?first dup prolog?
|
||||
[ drop default-prolog ] unless ;
|
||||
|
||||
: cut-prolog ( seq -- newseq )
|
||||
[ [ prolog? not ] [ "" = not ] bi and ] filter ;
|
||||
|
||||
: make-xml-doc ( seq -- xml-doc )
|
||||
[ get-prolog ] keep
|
||||
dup [ tag? ] find
|
||||
[ assure-tags cut rest no-pre/post no-post-tags ] dip
|
||||
swap <xml> ;
|
||||
dup [ tag? ] find [
|
||||
assure-tags cut
|
||||
[ cut-prolog ] [ rest ] bi*
|
||||
no-pre/post no-post-tags
|
||||
] dip swap <xml> ;
|
||||
|
||||
! * Views of XML
|
||||
|
||||
|
|
|
|||
|
|
@ -236,7 +236,7 @@ find_word_size() {
|
|||
|
||||
set_factor_binary() {
|
||||
case $OS in
|
||||
winnt) FACTOR_BINARY=factor-console.exe;;
|
||||
winnt) FACTOR_BINARY=factor.com;;
|
||||
*) FACTOR_BINARY=factor;;
|
||||
esac
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: 4DNav.space-file-decoder
|
|||
: decode-number-array ( x -- y )
|
||||
"," split [ string>number ] map ;
|
||||
|
||||
PROCESS: adsoda-read-model ( tag -- )
|
||||
TAGS: adsoda-read-model ( tag -- model )
|
||||
|
||||
TAG: dimension adsoda-read-model
|
||||
children>> first string>number ;
|
||||
|
|
@ -56,11 +56,9 @@ TAG: space adsoda-read-model
|
|||
;
|
||||
|
||||
: read-model-file ( path -- x )
|
||||
dup
|
||||
[
|
||||
[ file>xml "space" tags-named first adsoda-read-model ]
|
||||
[ drop <space> ] recover
|
||||
] [ drop <space> ] if
|
||||
|
||||
[
|
||||
[ file>xml "space" tag-named adsoda-read-model ]
|
||||
[ 2drop <space> ] recover
|
||||
] [ <space> ] if*
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,17 +2,25 @@ USING: arrays assocs help.markup help.syntax math.rectangles quadtrees quotation
|
|||
IN: quadtrees
|
||||
|
||||
ARTICLE: "quadtrees" "Quadtrees"
|
||||
"The " { $snippet "quadtrees" } " vocabulary implements the quadtree structure in Factor. Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
|
||||
{ $subsection prune }
|
||||
"The " { $snippet "quadtrees" } " vocabulary implements the quadtree data structure in Factor."
|
||||
{ $subsection <quadtree> }
|
||||
"Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
|
||||
{ $subsection in-rect }
|
||||
{ $subsection prune-quadtree }
|
||||
"The following words are provided to help write quadtree algorithms:"
|
||||
{ $subsection descend }
|
||||
{ $subsection each-quadrant }
|
||||
{ $subsection map-quadrant } ;
|
||||
{ $subsection map-quadrant }
|
||||
"Quadtrees can be used to \"swizzle\" a sequence to improve the locality of spatial data in memory:"
|
||||
{ $subsection swizzle } ;
|
||||
|
||||
ABOUT: "quadtrees"
|
||||
|
||||
HELP: prune
|
||||
HELP: <quadtree>
|
||||
{ $values { "bounds" rect } { "quadtree" quadtree } }
|
||||
{ $description "Constructs an empty quadtree covering the axis-aligned rectangle indicated by " { $snippet "bounds" } ". All the keys of " { $snippet "quadtree" } " must be two-dimensional vectors lying inside " { $snippet "bounds" } "." } ;
|
||||
|
||||
HELP: prune-quadtree
|
||||
{ $values { "tree" quadtree } }
|
||||
{ $description "Removes empty nodes from " { $snippet "tree" } "." } ;
|
||||
|
||||
|
|
@ -32,3 +40,6 @@ HELP: map-quadrant
|
|||
{ $values { "node" quadtree } { "quot" quotation } { "array" array } }
|
||||
{ $description "Calls " { $snippet "quot" } " with each subnode of " { $snippet "node" } " on the top of the stack in turn, collecting the four results into " { $snippet "array" } "." } ;
|
||||
|
||||
HELP: swizzle
|
||||
{ $values { "sequence" sequence } { "quot" quotation } { "sequence'" sequence } }
|
||||
{ $description "Swizzles " { $snippet "sequence" } " based on the two-dimensional vector values returned by calling " { $snippet "quot" } " on each element of " { $snippet "sequence" } "." } ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c) 2009 Joe Groff, see BSD license
|
||||
USING: assocs kernel tools.test quadtrees math.rectangles sorting ;
|
||||
USING: accessors assocs kernel tools.test quadtrees math.rectangles sorting ;
|
||||
IN: quadtrees.tests
|
||||
|
||||
: unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } <rect> ;
|
||||
|
|
@ -98,7 +98,7 @@ IN: quadtrees.tests
|
|||
"d" { 0.75 0.25 } value>>key
|
||||
|
||||
{ 0.25 0.25 } delete>>key
|
||||
prune
|
||||
prune-quadtree
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
|
|
@ -116,7 +116,7 @@ IN: quadtrees.tests
|
|||
|
||||
{ 0.25 0.25 } delete>>key
|
||||
{ 0.75 0.25 } delete>>key
|
||||
prune
|
||||
prune-quadtree
|
||||
] unit-test
|
||||
|
||||
[ T{ quadtree f T{ rect f { -1.0 -1.0 } { 2.0 2.0 } } f f
|
||||
|
|
@ -160,7 +160,7 @@ IN: quadtrees.tests
|
|||
"g" { 0.25 0.25 } value>>key
|
||||
"h" { 0.75 0.75 } value>>key
|
||||
|
||||
prune
|
||||
prune-quadtree
|
||||
] unit-test
|
||||
|
||||
[ 8 ] [
|
||||
|
|
@ -200,3 +200,42 @@ IN: quadtrees.tests
|
|||
>alist natural-sort
|
||||
] unit-test
|
||||
|
||||
TUPLE: pointy-thing center ;
|
||||
|
||||
[ {
|
||||
T{ pointy-thing f { 0 0 } }
|
||||
T{ pointy-thing f { 1 0 } }
|
||||
T{ pointy-thing f { 0 1 } }
|
||||
T{ pointy-thing f { 1 1 } }
|
||||
T{ pointy-thing f { 2 0 } }
|
||||
T{ pointy-thing f { 3 0 } }
|
||||
T{ pointy-thing f { 2 1 } }
|
||||
T{ pointy-thing f { 3 1 } }
|
||||
T{ pointy-thing f { 0 2 } }
|
||||
T{ pointy-thing f { 1 2 } }
|
||||
T{ pointy-thing f { 0 3 } }
|
||||
T{ pointy-thing f { 1 3 } }
|
||||
T{ pointy-thing f { 2 2 } }
|
||||
T{ pointy-thing f { 3 2 } }
|
||||
T{ pointy-thing f { 2 3 } }
|
||||
T{ pointy-thing f { 3 3 } }
|
||||
} ] [
|
||||
{
|
||||
T{ pointy-thing f { 3 1 } }
|
||||
T{ pointy-thing f { 2 3 } }
|
||||
T{ pointy-thing f { 3 2 } }
|
||||
T{ pointy-thing f { 0 1 } }
|
||||
T{ pointy-thing f { 2 2 } }
|
||||
T{ pointy-thing f { 1 1 } }
|
||||
T{ pointy-thing f { 3 0 } }
|
||||
T{ pointy-thing f { 3 3 } }
|
||||
T{ pointy-thing f { 1 3 } }
|
||||
T{ pointy-thing f { 2 1 } }
|
||||
T{ pointy-thing f { 0 0 } }
|
||||
T{ pointy-thing f { 2 0 } }
|
||||
T{ pointy-thing f { 1 0 } }
|
||||
T{ pointy-thing f { 0 2 } }
|
||||
T{ pointy-thing f { 1 2 } }
|
||||
T{ pointy-thing f { 0 3 } }
|
||||
} [ center>> ] swizzle
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -1,17 +1,19 @@
|
|||
! (c) 2009 Joe Groff, see BSD license
|
||||
USING: assocs kernel math.rectangles combinators accessors
|
||||
math.vectors vectors sequences math math.points math.geometry
|
||||
combinators.short-circuit arrays fry locals ;
|
||||
math.vectors vectors sequences math combinators.short-circuit arrays fry ;
|
||||
IN: quadtrees
|
||||
|
||||
TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ;
|
||||
|
||||
: <quadtree> ( bounds -- quadtree ) f f f f f f t quadtree boa ;
|
||||
: <quadtree> ( bounds -- quadtree )
|
||||
quadtree new
|
||||
swap >>bounds
|
||||
t >>leaf? ;
|
||||
|
||||
: rect-ll ( rect -- point ) loc>> ;
|
||||
: rect-lr ( rect -- point ) [ loc>> ] [ width ] bi v+x ;
|
||||
: rect-ul ( rect -- point ) [ loc>> ] [ height ] bi v+y ;
|
||||
: rect-ur ( rect -- point ) [ loc>> ] [ dim>> ] bi v+ ;
|
||||
: rect-lr ( rect -- point ) [ loc>> ] [ dim>> { 1 0 } v* ] bi v+ ;
|
||||
: rect-ul ( rect -- point ) [ loc>> ] [ dim>> { 0 1 } v* ] bi v+ ;
|
||||
: rect-ur ( rect -- point ) [ loc>> ] [ dim>> ] bi v+ ;
|
||||
|
||||
: rect-center ( rect -- point ) [ loc>> ] [ dim>> 0.5 v*n ] bi v+ ; inline
|
||||
|
||||
|
|
@ -26,11 +28,13 @@ TUPLE: quadtree { bounds rect } point value ll lr ul ur leaf? ;
|
|||
: descend ( pt node -- pt subnode )
|
||||
[ drop ] [ quadrant ] 2bi ; inline
|
||||
|
||||
:: each-quadrant ( node quot -- )
|
||||
node ll>> quot call
|
||||
node lr>> quot call
|
||||
node ul>> quot call
|
||||
node ur>> quot call ; inline
|
||||
: each-quadrant ( node quot -- )
|
||||
{
|
||||
[ [ ll>> ] [ call ] bi* ]
|
||||
[ [ lr>> ] [ call ] bi* ]
|
||||
[ [ ul>> ] [ call ] bi* ]
|
||||
[ [ ur>> ] [ call ] bi* ]
|
||||
} 2cleave ; inline
|
||||
: map-quadrant ( node quot: ( child-node -- x ) -- array )
|
||||
each-quadrant 4array ; inline
|
||||
|
||||
|
|
@ -73,6 +77,7 @@ DEFER: in-rect*
|
|||
[ node-insert ] [ node-insert ] bi ;
|
||||
|
||||
: leaf-replaceable? ( pt leaf -- ? ) point>> { [ nip not ] [ = ] } 2|| ;
|
||||
|
||||
: leaf-insert ( value point leaf -- )
|
||||
2dup leaf-replaceable?
|
||||
[ [ (>>point) ] [ (>>value) ] bi ]
|
||||
|
|
@ -94,12 +99,12 @@ DEFER: in-rect*
|
|||
dup leaf?>> [ leaf-at-point ] [ node-at-point ] if ;
|
||||
|
||||
: (node-in-rect*) ( values rect node -- values )
|
||||
2dup bounds>> intersects? [ in-rect* ] [ 2drop ] if ;
|
||||
2dup bounds>> contains-rect? [ in-rect* ] [ 2drop ] if ;
|
||||
: node-in-rect* ( values rect node -- values )
|
||||
[ (node-in-rect*) ] with each-quadrant ;
|
||||
|
||||
: leaf-in-rect* ( values rect leaf -- values )
|
||||
tuck { [ nip point>> ] [ point>> swap intersects? ] } 2&&
|
||||
tuck { [ nip point>> ] [ point>> swap contains-point? ] } 2&&
|
||||
[ value>> over push ] [ drop ] if ;
|
||||
|
||||
: in-rect* ( values rect tree -- values )
|
||||
|
|
@ -165,7 +170,7 @@ DEFER: in-rect*
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: prune ( tree -- tree ) [ (prune) ] keep ;
|
||||
: prune-quadtree ( tree -- tree ) [ (prune) ] keep ;
|
||||
|
||||
: in-rect ( tree rect -- values )
|
||||
[ 16 <vector> ] 2dip in-rect* ;
|
||||
|
|
@ -186,3 +191,8 @@ M: quadtree clear-assoc ( assoc -- )
|
|||
f >>value
|
||||
drop ;
|
||||
|
||||
: swizzle ( sequence quot -- sequence' )
|
||||
[ dup ] dip map
|
||||
[ zip ] [ rect-containing <quadtree> ] bi
|
||||
[ '[ first2 _ set-at ] each ] [ values ] bi ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ CFLAGS += -DWINDOWS -mno-cygwin
|
|||
LIBS = -lm
|
||||
PLAF_DLL_OBJS += vm/os-windows.o
|
||||
EXE_EXTENSION=.exe
|
||||
CONSOLE_EXTENSION=.com
|
||||
DLL_EXTENSION=.dll
|
||||
LINKER = $(CC) -shared -mno-cygwin -o
|
||||
LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)
|
||||
|
|
|
|||
|
|
@ -6,4 +6,5 @@ PLAF_EXE_OBJS += vm/resources.o
|
|||
PLAF_EXE_OBJS += vm/main-windows-nt.o
|
||||
CFLAGS += -mwindows
|
||||
CFLAGS_CONSOLE += -mconsole
|
||||
CONSOLE_EXTENSION = .com
|
||||
include vm/Config.windows
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
DLL_PATH=http://factorcode.org/dlls
|
||||
WINDRES=windres
|
||||
include vm/Config.windows.nt
|
||||
include vm/Config.x86.32
|
||||
|
|
|
|||
|
|
@ -1,3 +1,5 @@
|
|||
#error "lol"
|
||||
DLL_PATH=http://factorcode.org/dlls/64
|
||||
CC=$(WIN64_PATH)-gcc.exe
|
||||
WINDRES=$(WIN64_PATH)-windres.exe
|
||||
include vm/Config.windows.nt
|
||||
|
|
|
|||
|
|
@ -109,17 +109,6 @@ const F_CHAR *default_image_path(void)
|
|||
snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
|
||||
temp_path[sizeof(temp_path) - 1] = 0;
|
||||
|
||||
if(!windows_stat(temp_path)) {
|
||||
unsigned int len = wcslen(full_path);
|
||||
F_CHAR magic[] = L"-console";
|
||||
unsigned int magic_len = wcslen(magic);
|
||||
|
||||
if(!wcsncmp(full_path + len - magic_len, magic, MIN(len, magic_len)))
|
||||
full_path[len - magic_len] = 0;
|
||||
snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
|
||||
temp_path[sizeof(temp_path) - 1] = 0;
|
||||
}
|
||||
|
||||
return safe_strdup(temp_path);
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue