2009-05-28 20:01:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors models models.arrow inverse kernel ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-15 17:58:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: models.illusion
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: illusion < arrow ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <illusion> ( model quot -- illusion )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-31 12:40:03 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    swap >>quot over >>model [ add-dependency ] keep ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-15 17:58:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-16 11:46:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: backtalk ( value object -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-15 17:58:17 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-15 20:31:43 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ;
							 |