loading...
welcome to asocialOS
viewer
validator
browser
viewer -
(defstruct (world (:print-function
						 (lambda (s d o)
							(declare (ignore d))
							(format s "#<world: ~D>" (world-numdots world)))))
	size
	current
	numdots
	next
	(xmin 1000000)
	(xmax -1)
	(ymin 1000000)
	(ymax -1))

(defun setnext (world i j)
	(let* ((current (world-current world))
			(next (world-next world))
			(neighbors (count-neighbors current i j)))
	 (if (zerop (bit current i j))
	(cond ((not (= neighbors 3))
			 (setf (bit next i j) 0))	
			(t (setf (bit next i j) 1)
		 (incf (world-numdots world)))) 
			(cond ((or (= neighbors 2) 
			(= neighbors 3))
			 (setf (bit next i j) 1))	
			(t (setf (bit next i j) 0)
						(decf (world-numdots world)))))
	 (unless (zerop (bit next i j))
		(when (< i (world-xmin world)) (setf (world-xmin world) i))
		(when (> i (world-xmax world)) (setf (world-xmax world) i))
		(when (< j (world-ymin world)) (setf (world-ymin world) j))
		(when (> j (world-ymax world)) (setf (world-ymax world) j)))))

(defun count-neighbors (array i j)
	(+ (bit array (1- i) (1- j))
		(bit array i		(1- j))
		(bit array (1+ i) (1- j))
		(bit array (1- i) j)
		(bit array (1+ i) j)
		(bit array (1- i) (1+ j))
		(bit array i		(1+ j))
		(bit array (1+ i) (1+ j))))

(defun next-cycle (world)
	(let* ((lim (world-size world))
			(current (world-current world))
			(next (world-next world))
			(xlb (max 1 (1- (world-xmin world))))
			(xub (min (- lim 2) (1+ (world-xmax world))))
			(ylb (max 1 (1- (world-ymin world))))
			(yub (min (- lim 2) (1+ (world-ymax world)))))
	 (dotimes (i (1+ (- xub xlb)))
		(dotimes (j (1+ (- yub ylb)))
			(setnext world (+ i xlb) (+ j ylb))))
	 (dotimes (y lim)
		(dotimes (x lim)
			(setf (bit current x y) (bit next x y))))))

(defun print-world (world generations)
	(let ((lim (world-size world))
			(current (world-current world)))
	 (dotimes (y lim)
		(dotimes (x lim)
			(if (zerop (bit current y x))
				(princ " ")
				(princ "*")))
		(terpri))
	 (format t "~&~d Generations, ~d Organisms." 
				generations (world-numdots world))))

(defun propagate (world cycles)
	(print-world world cycles)
	(do ()
		((zerop (world-numdots world))
		 (format t "~2&POPULATION 0 ... ~d generations" cycles))
	 (next-cycle world)
	 (incf cycles)
	 (print-world world cycles)))

(defun life (source)
	(let* ((size (length (car source)))
			(life (make-world
					 :size size
					 :current (make-array (list size size) :element-type "bit
																		:initial-contents source)
					 :next (make-array (list size size) :element-type "bit
																	:initial-element 0)
					 :numdots 0)))
	 (dotimes (i size)
		(dotimes (j size)
			(unless (zerop (bit (world-current life) i j))
			 (incf (world-numdots life))
			 (when (< i (world-xmin life)) (setf (world-xmin life) i))
			 (when (> i (world-xmax life)) (setf (world-xmax life) i))
			 (when (< j (world-ymin life)) (setf (world-ymin life) j))
			 (when (> j (world-ymax life)) (setf (world-ymax life) j)))))
	 (propagate life 0)))


                  
                  ...::::::..                     
              .::::...   ...::::.                 
            .^:.      ..       .:^:               
           ^^   .^^!~!!~~~^:.     :^.             
          ~.  :77~7^!~^^^^^^:^^     ~:            
         ~.  .7^::~^^:^^^^^^^^~~     ~.           
        :^   !7:::  :::^^^^!~~~!~    :^           
        ^:   ^75?7: ^?5~~^!~~^^~~     ~           
        :^   ^~~^~: .~!::.~?^^^~~    .~           
         ~.  :^  :~^      7~!~~7.    ~.           
         .~.  ^^  ^:    :J!^^^7^    ^:            
          .^:  :^: ...:^^J~~^~!   .^:             
            :^: ~^.:... ^7^~^~! .^^.              
              .!7~~^~:~^7^^~^~7!^                 
             .^!!!~!~~!~7! ~^~^^~.                
            :~:^^:~^^^^~^^^!.~:7^                 
           ^^!^!~:^7.::~:^~7~~:.                  
          ~^!.^.~:!.!~::^~~::!!.                  
         ^^^!^:!7..~!^^^^:^^~!.~.                 
         ! : !.^.!:7^^~^~~^!.^..!                 
         7^^:?^::7~!:.~:.~ .:.^~!^                
         ^::^.^:~.^:!..:.:^^~~^^^!.               
          ~:!^.:7~:~^7~^~^^^^^^^~.~               
           ~^^~^^^.:7~?^:~:^~ ~.^.^:              
            :^: :7~~~^!~:.^.:: . .:!              
              :~~~^^.^!~:^:. ..:^^^~^             
                :!^!^~!7  !7^^^~:^^ ~.            
                 ~:~!~^7. !~7~ :^ :^ ~            
                 ^: !:^!:.!^.!7:.^::^:~           
                 ^:.^  !^^! ^~^7^:::..:^          
                 ^:~.  :^!.~ ~::^:!:.  :^.        
                 ~^^   ^^7.:~.! ~ ^:.::.:^:.      
                :!^    ~~.7^~^!::^ ~   .::^~.     
              .:^~^:  :!^ !.~::~.~ !              
            :~~^:..~::^^~^~ ^..!^~^!              
           !~7!.  :~!~:..?! ~ ^:^^:~              
          :7 7:  !!~7.   !.:^ ~ ~ ~.              
             .   !.^~   ~!^~:~^^.:^               
                      .^~^~^~!^:^^                
                     :^^:^.~:?^^:                 
                    :^.~.~.~.!^                   
                    ~ ^::^ ~ !                    
                  .^~ ^..~ ^:.^.                  
                :^^^~ .~ ^^ ^:.:::.....::         
              :^^^^^!: :^ :^..:::::::::!:         
            :^:^:^:^^!: .^:.:::::::::^~^          
           ^::^.^.^:^:.^:..:::::::^~~~.           
          ~:.~ ~.:^ ~   .:::::^^^^^:              
         ^^ ~ :^ ~ :^                             
         ! .~ ^: ~ .~             we are
        .~ .^ ^^ ^: ^:                 always 
         !  ~  ~  ~. ^^.                  searching for
         ^^ :^ :~  ^: .:::...                       an answer 
          ^^ :^ .^: .^:....~^                        
           :^::^:.:::..:^~^.                      
             .::^~~^:^~^:.                        
                  ...
		  
validator -
we are here for you_
browser -
viewer
validator
browser
system message
OK