1:- [geons]. 2 3:- [data]. 4 5:- make_callback(quit_method/2). 6:- make_callback(point_method/2). 7:- make_callback(senders_method/2). 8:- make_callback(walls_method/2). 9:- make_callback(field_method/2). 10:- make_callback(refresh_method/2). 11:- make_callback(reset_method/2). 12:- make_callback(threshold_method/2). 13:- make_callback(approximation_method/2). 14:- make_callback(grid_size_method/2). 15:- make_callback(solve_method/2). 16:- make_callback(solve5_method/2). 17:- make_callback(abort_method/2). 18:- make_callback(nb_senders_method/2). 19:- make_callback(absorption_method/2). 20:- make_callback(on_walls_method/2). 21:- make_callback(ecrc_method/2). 22:- make_callback(farm_method/2). 23:- make_callback(mona_method/2). 24 25:- dynamic rectangles /5, rectangles5 /5, window_data/4. 26 27 28init_ecrc5 :- assert(rectangles5(building(20 # 12, 67 # 82), 29 grid_size(23), 30 wall_absorption(65), 31 _, 32 [[rect(47.4659462 # -28.5340538, 106.534058 # 28.5340538), rect(69.0 # 28.5340538, 109.0 # 48.5340538), rect(43.0 # -40.5340538, 89.0 # -28.5340538), rect(106.534058 # -14.0, 116.534058 # 38.0), rect(37.4659462 # -38.0, 47.4659462 # 22.0)], 33[rect(50.6074181 # 21.6074181, 107.392586 # 52.3925819), rect(55.0 # 52.3925819, 105.0 # 60.3925819), rect(61.0 # 5.60741806, 101.0 # 21.6074181), rect(107.392586 # 25.0, 111.392586 # 45.0), rect(44.6074181 # 25.0, 50.6074181 # 45.0)], 34[rect(49.4659462 # 35.4659462, 98.5340576 # 90.5340576), rect(48.0 # 90.5340576, 84.0 # 100.534058), rect(58.0 # 29.4659462, 102.0 # 35.4659462), rect(98.5340576 # 41.0, 108.534058 # 75.0), rect(41.4659462 # 49.0, 49.4659462 # 85.0)], 35 [rect(39.5875854 # 58.5875854, 98.4124146 # 113.412415), rect(47.0 # 113.412415, 85.0 # 123.412415), rect(53.0 # 46.5875854, 97.0 # 58.5875854), rect(98.4124146 # 62.0, 108.412415 # 100.0), rect(29.5875854 # 74.0, 39.5875854 # 108.0)], 36[rect(21.6074181 # -27.3925819, 66.3925781 # 25.3925819), rect(36.0 # 25.3925819, 60.0 # 31.3925819), rect(34.0 # -33.3925819, 52.0 # -27.3925819), rect(66.3925781 # -15.0, 80.3925781 # 13.0), rect(7.60741806 # -17.0, 21.6074181 # 11.0)], 37[rect(32.1520081 # 18.1520081, 55.8479919 # 53.8479919), rect(32.0 # 53.8479919, 50.0 # 57.8479919), rect(38.0 # 12.1520081, 52.0 # 18.1520081), rect(55.8479919 # 24.0, 63.8479919 # 44.0), rect(22.1520081 # 28.0, 32.1520081 # 44.0)], 38[rect(29.6074181 # 44.6074181, 56.3925819 # 71.3925858), rect(35.0 # 40.6074181, 51.0 # 44.6074181), rect(56.3925819 # 50.0, 62.3925819 # 66.0)], 39[rect(22.5875854 # 60.5875854, 75.4124146 # 113.412415), rect(45.0 # 113.412415, 61.0 # 123.412415), rect(4.58758545 # 59.0, 22.5875854 # 107.0)], 40[rect(-18.8806477 # -28.8806477, 36.8806458 # 30.8806477), rect(-29.0000019 # 30.8806477, 26.9999981 # 40.8806458), rect(-3.00000191 # -40.8806458, 43.0 # -28.8806477), rect(36.8806458 # -37.0, 48.8806458 # 19.0), rect(-30.8806477 # -15.0, -18.8806477 # 39.0)], 41 [rect(-11.3925829 # 15.6074181, 33.3925819 # 48.3925819), rect(-7.00000095 # 48.3925819, 19.0 # 68.3925781), rect(-3.00000095 # 5.60741806, 19.0 # 15.6074181), rect(33.3925819 # 26.0, 39.3925819 # 42.0), rect(-19.3925819 # 24.0, -11.3925829 # 46.0)], 42[rect(-13.3925829 # 42.6074181, 33.3925819 # 73.3925858), rect(-4.00000095 # 73.3925858, 32.0 # 85.3925858), rect(-4.00000095 # 28.6074181, 18.0 # 42.6074181), rect(33.3925819 # 44.0, 37.3925819 # 68.0), rect(-25.3925819 # 48.0, -13.3925829 # 68.0)], 43[rect(-20.371172 # 62.62883, 42.37117 # 121.37117), rect(-3.00000191 # 121.37117, 43.0 # 133.37117), rect(-29.0000019 # 52.62883, 26.9999981 # 62.62883), rect(42.37117 # 72.0, 56.37117 # 124.0), rect(-32.37117 # 58.0, -20.371172 # 104.0)]])). 44 45 46chr_demo :- 47 (open_pce -> true; true), % Point PCE server 48 send(@pce, log, off), % Do not write pce.log 49 50% open_2d(0,0,1,1), 51 dialog, 52 send(@panel, open, point(0, 0)), 53 ground_size(SizeX, SizeY), 54 scale_up(SizeX, SizeXX), scale_up(SizeY, SizeYY), 55% close_2d, 56 global(window_data/4), 57 asserta(window_data(345,70,800,800)), 58 open_2d(0, 0, SizeXX, SizeYY), 59 init. 60 61 62init :- setval(current_senders, []), 63 send(@senders, selection, 'No'), 64 setval(current_walls, []), 65 send(@walls, selection, 'No'), 66 setval(grid_size, 20), 67 send(@grid_size, selection, 20), 68 setval(nb_senders, 5), 69 send(@nb_senders, selection, 5), 70 setval(wall_absorption, 0), 71 send(@absorption, selection, 100), 72 ground_size(X, Y), 73 setval(building, (0#0, X#Y)), 74 retract_all(rectangles(_, _, _, _, _)), 75 retract_all(rectangles5(_, _, _, _, _)), 76 init_ecrc5. 77 78 79 80refresh_method(_, _) :- 81 clear_view_surface(0), 82 draw_building, 83 draw_senders. 84 85 86reset_method(_, _) :- 87 init, 88 refresh_method(_,_). 89 90 91senders_method(_, 'No') :- 92 !, 93 getval(current_senders, SenderList), 94 remove_senders(SenderList), 95 wprintf("Senders removed", []), 96 setval(current_senders, []). 97senders_method(_, Example) :- 98 senders_method(_, 'No'), 99 ( Example == 'Choose' 100 -> 101 choose_senders(SenderList) 102 ; 103 senders_name(Example, SenderList), 104 draw_senders(SenderList, 1) 105 ), 106 setval(current_senders, SenderList), 107 wprintf("Senders installed", []). 108 109 110walls_method(_, 'No') :- 111 !, 112 remove_walls, 113 wprintf("Walls removed", []), 114 setval(current_walls, []). 115walls_method(_, Example) :- 116 walls_method(_, 'No'), 117 ( Example == 'Choose' 118 -> 119 choose_walls(WallsList), 120 setval(current_walls, WallsList), 121 ground_size(MaxX, MaxY), 122 setval(building, (0#0, MaxX#MaxY)) 123 ; 124 building(Example, Building, WallsList), 125 setval(building, Building), 126 setval(current_walls, WallsList), 127 draw_building 128 ), 129 wprintf("Walls installed", []). 130 131 132dialog :- 133 new_dialog(@panel, "Cellular Phones", panel). 134 135point_method(_, _) :- 136 getval(current_senders, ListSenderName), 137 ( ListSenderName \== [] 138 -> 139 wprintf("Click right to quit", []), 140 inactive(@quit), 141 only_positions(ListSenderName, ListSender), 142 point_loop(ListSender), 143 wprintf("Done", []), 144 active(@quit) 145 ; 146 wprintf("No senders\n", []) 147 ). 148 149point_loop(ListSender) :- 150 get_mouse(Button, Xf#Yf), 151 ( Button = 3 /*** right ***/ 152 -> true 153 ; 154 X is fix(Xf + 0.5), Y is fix(Yf + 0.5), 155 send(@mouseX, label, X), 156 send(@mouseY, label, Y), 157 ( point_intensity(ListSender, Xf#Yf, Sender, Intensity) -> true 158 ; Intensity is sender_intensity 159 ), 160 Intensity1 is intensity_normalize(Intensity), 161 send(@mouse_intensity, label, Intensity1), 162 getval(current_senders, ListSenderName), 163 memberchk((Sender, SenderName), ListSenderName), 164 send(@mouse_sender, label, SenderName), 165 point_loop(ListSender) 166 ). 167 168 169choose_senders(ListSender) :- 170 wprintf("Click right to quit", []), 171 inactive(@quit), 172 choose_senders_loop(1, ListSender), 173 wprintf("Done", []), 174 active(@quit). 175 176choose_senders_loop(Name, ListSender) :- 177 get_mouse(Button, Xf#Yf), 178 ( Button = 3 /*** right ***/ 179 -> ListSender = [] 180 ; 181 X is fix(Xf + 0.5), Y is fix(Yf + 0.5), 182 send(@mouseX, label, X), 183 send(@mouseY, label, Y), 184 scale_up(X, XX), scale_up(Y, YY), 185 text(XX, YY, Name), 186 Name1 is Name + 1, 187 ListSender = [(X#Y, Name) | ListSender1], 188 choose_senders_loop(Name1, ListSender1) 189 ). 190 191 192choose_walls(ListWall) :- 193 wprintf("Click right to quit", []), 194 inactive(@quit), 195 choose_walls_loop(ListWall), 196 wprintf("Done", []), 197 active(@quit). 198 199choose_walls_loop(ListWall) :- 200 get_mouse(Button, X1f#Y1f, X2f#Y2f), 201 ( Button = 3 /*** right ***/ 202 -> ListWall = [] 203 ; 204 ListWall = [wall(X1f#Y1f, X2f#Y2f) | ListWall1], 205 choose_walls_loop(ListWall1) 206 ). 207 208 209threshold_method(_, _) :- 210 getval(current_senders, ListSenderName), 211 ( ListSenderName \== [] 212 -> 213 wprintf("Drawing...", []), 214 only_positions(ListSenderName, ListSender), 215 nested, 216 block((do_threshold(ListSender), wprintf("Done", [])), 217 abort_block_tag, 218 wprintf("Aborted", [])), 219 inactive(@abort) 220 ; 221 wprintf("No senders\n", []) 222 ). 223 224do_threshold(ListSender) :- 225 color_areas(LL, 1), 226 senders_threshold_points(ListSender, 72, LL), 227 !. 228 229approximation_method(_, _) :- 230 wprintf("(1) Click Left, (5) Click Middle", []), 231 get_mouse(Button, Xf#Yf), 232 X is fix(Xf + 0.5), Y is fix(Yf + 0.5), 233 send(@mouseX, label, X), 234 send(@mouseY, label, Y), 235 color_areas(LL, 4), 236 senders_threshold_points([Xf#Yf], 72, LL), 237 interior_style(0, 1), 238 perimeter_color(1), 239 perimeter_width(3), 240 perimeter_type(2), 241 ( Button = 1 %%% Left 242 -> 243 covered_rectangle(Xf#Yf, P1, P2), 244 draw_rectangle(P1, P2) 245 ; 246 covered_rectangles(Xf#Yf, ListRect), 247 l_draw_rectangle(ListRect) 248 ), 249 wprintf("Done", []). 250 251l_draw_rectangle([]). 252l_draw_rectangle([rect(X1#Y1, X2#Y2) | Rectangles]) :- 253 draw_rectangle(X1#Y1, X2#Y2), 254 l_draw_rectangle(Rectangles). 255 256draw_rectangle(X1f#Y1f, X2f#Y2f) :- 257 X1 is fix(X1f + 0.5), X2 is fix(X2f + 0.5), 258 Y1 is fix(Y1f + 0.5), Y2 is fix(Y2f + 0.5), 259 perimeter_width(2), 260 scaled_rectangle(X1, Y1, X2, Y2). 261 262 263 264 265 266quit_method(_, _) :- 267 send(@panel, destroy), 268 call(get_flag(window_data/4, definition_module, demo), kegi), 269 local(window_data/4), 270 close_2d. 271 272grid_size_method(_, X) :- 273 setval(grid_size, X). 274 275nb_senders_method(_, X) :- 276 setval(nb_senders, X). 277 278 279absorption_method(_, X) :- 280 Y is 100 - X, 281 setval(wall_absorption, Y). 282 283on_walls_method(_, 'Anywhere') :- 284 !, 285 send(@on_walls, label, 'On Walls'). 286on_walls_method(_, 'On Walls') :- 287 !, 288 send(@on_walls, label, 'Anywhere'). 289 290 291 292solve_method(_, _) :- 293 nested, 294 block(solve_block, abort_block_tag, wprintf("Aborted", [])), 295 inactive(@abort). 296 297solve_block :- 298 wprintf("Running", []), 299 compute_rectangles(ListRectangle), 300 getval(nb_senders, NS), 301 make_senders(NS, ListSenderName), 302 setval(nb_backtracks, 0), 303 send(@backtracks, label, 0), 304 ( solution(ListSenderName, ListRectangle) 305 -> 306 remove_useless_senders(ListSenderName, ListSenderName1, N), 307 senders_method(_, 'No'), 308 setval(current_senders, ListSenderName1), 309 draw_senders, 310 wprintf("Solution Found: %d Senders", [N]) 311 ; 312 wprintf("No Solution", []) 313 ). 314 315 316 317compute_rectangles(ListRectangle) :- 318 getval(building, (X1#Y1, X2#Y2)), 319 getval(grid_size, GS), 320 getval(wall_absorption, WA), 321 getval(current_walls, Walls), 322 rectangles(building(X1#Y1, X2#Y2), grid_size(GS), wall_absorption(WA), walls(Walls), ListRectangle), 323 !, 324 wprintf("Rectangles already computed", []). 325compute_rectangles(ListRectangle) :- 326 getval(building, (X1#Y1, X2#Y2)), 327 getval(grid_size, GS), 328 appr_foreachX(X1, X2, GS, Y1, Y2, []-ListRectangle), 329 getval(wall_absorption, WA), 330 getval(current_walls, Walls), 331 assert(rectangles(building(X1#Y1, X2#Y2), grid_size(GS), wall_absorption(WA), walls(Walls), ListRectangle)), 332 wprintf("Rectangles Computed", []). 333 334 335compute_5rectangles(LLRectangle) :- 336 getval(building, (X1#Y1, X2#Y2)), 337 getval(grid_size, GS), 338 getval(wall_absorption, WA), 339 getval(current_walls, Walls), 340 rectangles5(building(X1#Y1, X2#Y2), grid_size(GS), wall_absorption(WA), walls(Walls), LLRectangle), 341 !, 342 wprintf("Rectangles already computed", []). 343compute_5rectangles(LLRectangle) :- 344 getval(building, (X1#Y1, X2#Y2)), 345 getval(grid_size, GS), 346 appr5_foreachX(X1, X2, GS, Y1, Y2, []-LLRectangle), 347 getval(wall_absorption, WA), 348 getval(current_walls, Walls), 349 assert(rectangles5(building(X1#Y1, X2#Y2), grid_size(GS), wall_absorption(WA), walls(Walls), LLRectangle)), 350 wprintf("Rectangles Computed", []). 351 352 353 354solve5_method(_, _) :- 355 nested, 356 block(solve5_block, abort_block_tag, wprintf("Aborted", [])), 357 inactive(@abort). 358 359solve5_block :- 360 wprintf("Running", []), 361 compute_5rectangles(LLRectangle), 362 getval(nb_senders, NS), 363 make_senders(NS, ListSenderName), 364 setval(nb_backtracks, 0), 365 send(@backtracks, label, 0), 366 ( solution5(ListSenderName, LLRectangle) 367 -> 368 remove_useless_senders(ListSenderName, ListSenderName1, N), 369 senders_method(_, 'No'), 370 setval(current_senders, ListSenderName1), 371 draw_senders, 372 wprintf("Solution Found: %d Senders", [N]) 373 ; 374 wprintf("No Solution", []) 375 ). 376 377abort_method(_, _) :- 378 exit_block(abort_block_tag). 379 380remove_useless_senders([], [], 0). 381remove_useless_senders([(X#Y, Name) | ListSender], [(X#Y, Name) | ListSender1], N) :- 382 atomic(X), 383 remove_useless_senders(ListSender, ListSender1, N1), 384 N is N1 + 1. 385remove_useless_senders([(_X#_Y, _) | ListSender], ListSender1, N) :- 386 remove_useless_senders(ListSender, ListSender1, N). 387 388 389 390make_senders(0, []) :- !. 391make_senders(N, [(X#Y, N) | ListSender]) :- 392 N1 is N - 1, 393 make_senders(N1, ListSender). 394 395 396solution(ListSenderName, ListRectangle) :- 397 choose_senders(ListRectangle, [], ListSenderName), 398 chr_labeling. 399 400 401solution5(ListSenderName, LLRectangle) :- 402 choose_senders5(LLRectangle, [], ListSenderName), 403 chr_labeling. 404 405 406choose_senders([], [], _) :- !. 407choose_senders([], [rect(P1, P2) | Rectangles], ListSenderName) :- 408 one_sender_in_the_rectangle(ListSenderName, P1, P2), 409 choose_senders([], Rectangles, ListSenderName). 410choose_senders([rect(P1, P2) | Rectangles], OtherRectangles, ListSenderName) :- 411 ( new_sender_in_the_rectangle(ListSenderName, P1, P2) 412 -> 413 choose_senders(Rectangles, OtherRectangles, ListSenderName) 414 ; 415 choose_senders(Rectangles, [rect(P1, P2) | OtherRectangles], ListSenderName) 416 ). 417 418 419choose_senders5([], [], _). 420choose_senders5([], [LRectangle | LLRectangle], ListSenderName) :- 421 one_sender_in_one_rectangle(ListSenderName, LRectangle), 422 choose_senders5([], LLRectangle, ListSenderName). 423choose_senders5([LRectangle | LLRectangle], OtherLLRect, ListSenderName) :- 424 ( new_sender_in_one_rectangle(ListSenderName, LRectangle) 425 -> 426 choose_senders5(LLRectangle, OtherLLRect, ListSenderName) 427 ; 428 choose_senders5(LLRectangle, [LRectangle | OtherLLRect], ListSenderName) 429 ). 430 431 432put_sender(Sender) :- 433 get(@on_walls, label, 'Anywhere'), 434 !, 435 getval(building, (P1, P2)), 436 geon(Sender, P1, P2). 437put_sender(Sender) :- 438 getval(current_walls, CW), 439 approx_walls(CW, ACW), 440 geons(Sender, ACW). 441 442 443one_sender_in_the_rectangle([(X#Y, _Name) | _Senders], X1#Y1, X2#Y2) :- 444 ( (atomic(X) ; constrained(X)) -> true 445 ; !, 446 put_sender(X#Y) 447 ), 448 geon(X#Y, X1#Y1, X2#Y2). 449one_sender_in_the_rectangle(_, _, _) :- 450 incval(nb_backtracks), 451 getval(nb_backtracks, N), 452 ( N mod 100 =:= 0 -> send(@backtracks, label, N) ; true), 453 fail. 454one_sender_in_the_rectangle([_ | Senders], P1, P2) :- 455 one_sender_in_the_rectangle(Senders, P1, P2). 456 457 458new_sender_in_the_rectangle([(X#Y, _Name) | _Senders], X1#Y1, X2#Y2) :- 459 ( (atomic(X) ; constrained(X)) 460 -> OldSender = true 461 ; 462 put_sender(X#Y) 463 ), 464 geon(X#Y, X1#Y1, X2#Y2), 465 !, 466 var(OldSender). 467new_sender_in_the_rectangle([_ | Senders], P1, P2) :- 468 new_sender_in_the_rectangle(Senders, P1, P2). 469 470 471one_sender_in_one_rectangle([(X#Y, _Name) | _Senders], LRectangle) :- 472 ( constrained(X) -> true 473 ; !, 474 put_sender(X#Y) 475 ), 476 sender_in_one_rectangle(X#Y, LRectangle). 477one_sender_in_one_rectangle(_, _) :- 478 incval(nb_backtracks), 479 getval(nb_backtracks, N), 480 ( N mod 100 =:= 0 -> send(@backtracks, label, N) ; true), 481 fail. 482one_sender_in_one_rectangle([_ | Senders], LRectangle) :- 483 one_sender_in_one_rectangle(Senders, LRectangle). 484 485 486new_sender_in_one_rectangle([(X#Y, _Name) | _Senders], LRectangle) :- 487 ( (atomic(X) ; constrained(X)) 488 -> 489 sender_in_one_rectangle(X#Y, LRectangle), 490 !, 491 fail 492 ; !, 493 put_sender(X#Y), 494 sender_in_one_rectangle(X#Y, LRectangle) 495 ). 496new_sender_in_one_rectangle([_ | Senders], LRectangle) :- 497 new_sender_in_one_rectangle(Senders, LRectangle). 498 499/*** 500sender_in_one_rectangle(X#Y, [rect(X1#Y1, X2#Y2) | _LRectangle]) :- 501 geon(X#Y, X1#Y1, X2#Y2). 502sender_in_one_rectangle(X#Y, [_ | LRectangle]) :- 503 sender_in_one_rectangle(X#Y, LRectangle). 504***/ 505sender_in_one_rectangle(Point, LRect) :- 506 geons(Point, LRect). 507 508 509 510appr_foreachX(X, XMax, _Incr, _YMin, _YMax, LR-LR) :- 511 X > XMax, !. 512appr_foreachX(X, XMax, Incr, YMin, YMax, LR1-LR0) :- 513 appr_foreachY(YMin, YMax, Incr, X, LR1-LR2), 514 NX is X + Incr, 515 appr_foreachX(NX, XMax, Incr, YMin, YMax, LR2-LR0). 516 517 518appr_foreachY(Y, YMax, _, _, LR-LR) :- 519 Y > YMax, !. 520appr_foreachY(Y, YMax, Incr, X, LR1-[rect(X1f#Y1f, X2f#Y2f) | LR0]) :- 521 covered_rectangle(X#Y, X1f#Y1f, X2f#Y2f), 522 perimeter_color(10), 523/***/ scaled_circle(X, Y, 1), 524/*** draw_rectangle(X1#Y1, X2#Y2), ***/ 525 NY is Y + Incr, 526 appr_foreachY(NY, YMax, Incr, X, LR1-LR0). 527 528 529 530appr5_foreachX(X, XMax, _Incr, _YMin, _YMax, LR-LR) :- 531 X > XMax, !. 532appr5_foreachX(X, XMax, Incr, YMin, YMax, LR1-LR0) :- 533 appr5_foreachY(YMin, YMax, Incr, X, LR1-LR2), 534 NX is X + Incr, 535 appr5_foreachX(NX, XMax, Incr, YMin, YMax, LR2-LR0). 536 537 538appr5_foreachY(Y, YMax, _, _, LR-LR) :- 539 Y > YMax, !. 540appr5_foreachY(Y, YMax, Incr, X, LR1-[Rectangles | LR0]) :- 541 covered_rectangles(X#Y, Rectangles), 542 perimeter_color(10), 543/***/ scaled_circle(X, Y, 1), 544 NY is Y + Incr, 545 appr5_foreachY(NY, YMax, Incr, X, LR1-LR0). 546 547 548l_fix_rectangles([], []). 549l_fix_rectangles([rect(X1f#Y1f, X2f#Y2f) | Rectanglesf], [rect(X1#Y1, X2#Y2) | Rectangles]) :- 550 X1 is fix(X1f + 0.5), X2 is fix(X2f + 0.5), 551 Y1 is fix(Y1f + 0.5), Y2 is fix(Y2f + 0.5), 552 l_fix_rectangles(Rectanglesf, Rectangles). 553 554 555 556draw_building :- 557 getval(building, (UpLeftX#UpLeftY, DownRightX#DownRightY)), 558 interior_style(0, 1), 559 perimeter_color(1), 560 perimeter_width(4), 561 perimeter_type(0), 562 scaled_rectangle(UpLeftX, UpLeftY, DownRightX, DownRightY), 563 draw_walls. 564 565 566draw_senders :- 567 getval(current_senders, ListSender), 568/*** character_height(50), not supported with X11 interface ***/ 569 draw_senders(ListSender, 1). 570 571 572draw_senders([], _). 573draw_senders([(X#Y, Name) | SenderList], ColorName) :- 574 scale_up(X, XX), scale_up(Y, YY), 575 interior_style(1, 0), 576 pick_color(ColorName, Color), 577 fill_color(Color), 578 perimeter_color(2), 579 perimeter_type(0), 580 perimeter_width(2), 581 XX1 is XX + 1, YY1 is YY + 2, 582 scale_up(1.5, RR), 583 circle(XX1, YY1, RR), 584 text(XX, YY, Name), 585 next_color(ColorName, ColorName1), 586 draw_senders(SenderList, ColorName1). 587 588 589remove_senders(SenderList) :- 590 text_color(0), 591 draw_senders(SenderList, 0), 592 text_color(1). 593 594 595get_mouse(Button, X#Y) :- 596 mouse(Button, XX, YY), 597 scale_up(X, XX), scale_up(Y, YY). 598 599get_mouse(Button, X1#Y1, X2#Y2) :- 600 mouse1(2, Button, XX1, YY1, XX2, YY2), 601 line_color(1), 602 line(XX1, YY1, XX2, YY2), 603 scale_up(X1, XX1), scale_up(Y1, YY1), 604 scale_up(X2, XX2), scale_up(Y2, YY2). 605 606 607draw_walls :- 608 getval(current_walls, WallList), 609 line_color(1), 610 line_width(1), 611 do_draw_walls(WallList). 612 613remove_walls :- 614 getval(current_walls, WallList), 615 line_color(0), 616 line_width(1), 617 do_draw_walls(WallList). 618 619do_draw_walls([]). 620do_draw_walls([wall(X1f#Y1f, X2f#Y2f) | WallList]) :- 621 X1 is fix(X1f + 0.5), Y1 is fix(Y1f + 0.5), 622 X2 is fix(X2f + 0.5), Y2 is fix(Y2f + 0.5), 623 scaled_line(X1, Y1, X2, Y2), 624 do_draw_walls(WallList). 625 626 627scale(5). 628 629scale_up(X, XX) :- 630 var(XX), !, 631 XX is fix(X * scale + 0.5). 632scale_up(X, XX) :- 633 var(X), !, 634 X is XX / scale. 635 636scaled_rectangle(X1, Y1, X2, Y2) :- 637 scale_up(X1, XX1), 638 scale_up(X2, XX2), 639 scale_up(Y1, YY1), 640 scale_up(Y2, YY2), 641 rectangle(XX1, YY1, XX2, YY2). 642 643scaled_circle(X, Y, R) :- 644 scale_up(X, XX), 645 scale_up(Y, YY), 646 scale_up(R, RR), 647 perimeter_width(10), 648 fill_color(10), 649 interior_style(1, 1), 650/*** perimeter_type(0), ***/ 651 circle(XX, YY, RR). 652 653 654scaled_line(X1, Y1, X2, Y2) :- 655 scale_up(X1, XX1), 656 scale_up(X2, XX2), 657 scale_up(Y1, YY1), 658 scale_up(Y2, YY2), 659 line(XX1, YY1, XX2, YY2). 660 661panel(@quit, button("Quit", quit_method), append, []). 662panel(@abort, button("Abort", abort_method), right, [active:off, greyed:on]). 663panel(@refresh, button("Refresh", refresh_method), right, []). 664panel(@reset, button("Reset", reset_method), right, []). 665panel(@message_label, label(x, " "), right, []). 666panel(@senders, menu("Senders", cycle, senders_method, ['No', 'Choose' | L]), below, []) :- 667 findall(Example, senders(Example, _), L). 668panel(@walls, menu("Building", cycle, walls_method, ['No', 'Choose' | L]), right, []) :- 669 findall(Example, building(Example, _, _), L). 670 671panel(@absorption, slider("Wall Absorption", 0, 100, 75, absorption_method), below, []). 672panel(@point, button("Point", point_method), below, []). 673panel(@threshold, button("Threshold", threshold_method), right, []). 674panel(@approximation, button("Approximation", approximation_method), right, []). 675panel(@mouseX_label, label(x, "X: "), below, []). 676panel(@mouseX, label(x, " "), right, []). 677panel(@mouseY_label, label(x, "Y: "), right, []). 678panel(@mouseY, label(x, " "), right, []). 679panel(@mouse_intensity_label, label(x, "Intensity: "), right, []). 680panel(@mouse_intensity, label(x, " "), right, []). 681panel(@mouse_sender_label, label(x, "Sender: "), right, []). 682panel(@mouse_sender, label(x, ""), right, []). 683panel(@grid_size, slider("Grid Size", 1, 40, 20, grid_size_method), below, []). 684panel(@solve, button("Solve (1)", solve_method), below, []). 685panel(@solve5, button("Solve (5)", solve5_method), right, []). 686panel(@on_walls, button("Anywhere", on_walls_method), right, []). 687panel(@backtracks_label, label(x, "Backtracks: "), right, []). 688panel(@backtracks, label(x, ""), right, []). 689panel(@nb_senders, slider("At most Senders", 1, 10, 5, nb_senders_method), below, []). 690 691 692panel(@mona, button("Mona", mona_method), below, []). 693panel(@ecrc, button("ECRC", ecrc_method), right, []). 694panel(@farm, button("Farm", farm_method), right, []). 695 696 697wprintf(Format,Args) :- 698 open(_,string,s), % Make output string 699 printf(s,Format,Args), 700 current_stream(S,_,s), 701 close(s), 702 703 send(@message_label,label,S). 704 705active(Object) :- 706 send(Object,active,on), 707 send(Object,greyed,off). 708 709inactive(Object) :- 710 send(Object,active,off), 711 send(Object,greyed,on). 712 713 714only_positions([], []). 715only_positions([(Pos, _Name) | L], [Pos | L1]) :- 716 only_positions(L, L1). 717 718 719senders(Example, ListSender1) :- 720 senders_name(Example, ListSender), 721 only_positions(ListSender, ListSender1). 722 723 724intensity_normalize(Intensity, I) :- 725 I is min(fix(Intensity + 0.5), sender_intensity). 726 727 728delay color_areas(LA, _Color) if var(LA). 729color_areas([], _) :- 730 set_gc(xFunction(xCopy)), 731 draw_senders, 732 draw_building. 733color_areas([area(X#Y, LPoint) | Areas], ColorName) :- 734 pick_color(ColorName, Color), 735 fill_color(Color), 736 interior_style(3, 1), 737 perimeter_type(0), 738 perimeter_color(Color), 739 scale_up(X, XX), scale_up(Y, YY), 740 link_points(XX#YY, LPoint), 741 next_color(ColorName, ColorName1), 742 color_areas(Areas, ColorName1). 743 744 745delay l_link_points(LL) if var(LL). 746l_link_points([]). 747l_link_points([ListPoint | LLPoint]) :- 748 link_points(ListPoint), 749 l_link_points(LLPoint). 750 751delay link_points(_, L) if var(L). 752link_points(_, []). 753link_points(X#Y, [First | ListPoint]) :- 754 do_link_points(X#Y, First, ListPoint, First). 755 756delay do_link_points(_X#_Y, _, L, _) if var(L). 757delay do_link_points(_X#_Y, _, [P | _], _) if nonground(P). 758do_link_points(X#Y, X1#Y1, [], X2#Y2) :- !, 759 scale_up(X1, XX1), scale_up(Y1, YY1), 760 scale_up(X2, XX2), scale_up(Y2, YY2), 761 set_gc(xFunction(xOr)), 762 polygon([X, Y, XX1, YY1, XX2, YY2]). 763do_link_points(X#Y, X1#Y1, [X2#Y2 | Points], Last) :- 764 scale_up(X1, XX1), scale_up(Y1, YY1), 765 scale_up(X2, XX2), scale_up(Y2, YY2), 766 set_gc(xFunction(xOr)), 767 polygon([X, Y, XX1, YY1, XX2, YY2]), 768 do_link_points(X#Y, X2#Y2, Points, Last). 769 770 771nested :- 772 active(@abort), % Unblock the control panel 773 reset_pce. % Unblock PCE's output to Sepia 774 775not_nested :- 776 send(@panel, active, off). % Block the control panel 777 778 779next_color(0, 0) :- !. 780next_color(C, C1) :- 781 C1 is C + 1. 782 783 784pick_color(0, 0). 785pick_color(1, 10). 786pick_color(2, 20). 787pick_color(3, 30). 788pick_color(4, 60). 789pick_color(5, 70). 790pick_color(6, 14). 791pick_color(7, 23). 792pick_color(8, 10). 793pick_color(9, 20). 794pick_color(10, 30). 795 796ecrc_method(_, _) :- 797 send(@senders, selection, 'No'), 798 senders_method(_, 'No'), 799 refresh_method(_,_), 800 send(@walls, selection, 'ECRC'), 801 walls_method(_, 'ECRC'), 802 send(@absorption, selection, 35), 803 absorption_method(_, 35), 804 send(@grid_size, selection, 23), 805 grid_size_method(_, 23), 806 send(@nb_senders, selection, 5), 807 nb_senders_method(_, 5), 808 send(@on_walls, label, 'On Walls'), 809 810 load_bitmap_file("ecrc.xwd"), 811 pixel_array(50, 500), 812 erase(bitmap, _). 813 814farm_method(_, _) :- 815 send(@senders, selection, 'No'), 816 senders_method(_, 'No'), 817 refresh_method(_,_), 818 send(@walls, selection, 'Farm'), 819 walls_method(_, 'Farm'), 820 send(@absorption, selection, 100), 821 absorption_method(_, 100), 822 send(@grid_size, selection, 22), 823 grid_size_method(_, 22), 824 send(@nb_senders, selection, 3), 825 nb_senders_method(_, 3), 826 send(@on_walls, label, 'Anywhere'), 827 828 load_bitmap_file("farm.xwd"), 829 pixel_array(50, 500), 830 erase(bitmap, _). 831mona_method(_, _) :- 832 send(@senders, selection, 'No'), 833 senders_method(_, 'No'), 834 refresh_method(_,_), 835 send(@walls, selection, 'Mona'), 836 walls_method(_, 'Mona'), 837 send(@absorption, selection, 50), 838 absorption_method(_, 50), 839 send(@grid_size, selection, 17), 840 grid_size_method(_, 17), 841 send(@nb_senders, selection, 4), 842 nb_senders_method(_, 4), 843 send(@on_walls, label, 'Anywhere'), 844 845 load_bitmap_file("mona.xwd"), 846 set_gc(xForeground(222)), 847 set_gc(xBackground(0)), 848 pixel_array(50, 420), 849 erase(bitmap, _). 850 851:- getcwd(Cwd), 852 compile_term([( 853load_bitmap_file(File) :- 854 concat_strings(Cwd, File, FullPath), 855 load_bitmap(FullPath) 856 )]). 857 858set_gc(_). 859/* 860set_gc(Val) :- 861 call(( 862 window_fact(_, C, _, _, _, _, _, _, _, _, _, _, 863 Gline, Gsolid, Gfill, _, _, Gbitmap), 864 xSetGC(C, Gbitmap, [Val]), 865 xSetGC(C, Gline, [Val]), 866 xSetGC(C, Gsolid, [Val]), 867 xSetGC(C, Gfill, [Val]) 868 ), kegi). 869 870 0 --> b 871 1 --> 1 872 0000 0001 873 bbbb 0001 874*/ 875