pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

Lisp pastebin - collaborative debugging tool View Help


Posted by Michoacano on Sat 17 May 17:49
report spam | download | new post

  1. (define (Abajo E)
  2.   (set 'b (find 0 E))
  3.   (cond
  4.    ((< (+ b 3) 9) (push (nth b E) E (+ b 3)) (pop E b)
  5.    (push
  6.    (pop E (+ b 3)) E b)
  7.         (Actualiza E)))
  8.        
  9.   (print E))
  10.  
  11.   (define (Izquierda E)
  12.   (set 'b (find 0 E))
  13.   (cond
  14.    ((= (= b 0) (= b 3) (= b 6) false) (push (nth b E) E (- b
  15.       1))
  16.     (pop E (+ b 1))
  17.         (Actualiza E)
  18.        
  19.         ))
  20.   (print E))
  21.  
  22.      
  23.  
  24. (define (Arriba E)
  25.   (set 'b (find 0 E))
  26.   (cond
  27.    ((> (- b 3) 0) (push (nth b E) E (- b 3)) (pop E (+ b 1))
  28.     (push (pop E (- b 2)) E b)
  29.                         (Actualiza E)
  30.         ))
  31.   (print E))
  32.  
  33.   (define (Derecha E)
  34.   (set 'b (find 0 E))
  35.   (cond
  36.    ((= (= b 2) (= b 5) (= b 8) false) (push (nth b E) E (+ b
  37.       2))
  38.     (pop E b)
  39.         (Actualiza E)
  40.         ))
  41.   (print E))
  42.  
  43. (define (Busca EI EM | Res)
  44.   (set 'EdosTrat '())
  45.   (set 'Res (BusAProf 1 EI EM Operadores))
  46.   (if (not (empty? Res))
  47.    (print Res)
  48.    (print "\nNo hay solucion\n")))
  49.    
  50.    (define (BusAProf Nivel EA EM Ops | ROps OpActual Encontrado NE)
  51.   (set 'ROps Ops)
  52.   (set 'Encontrado '())
  53.   (setq EdosTrat (cons EA EdosTrat))
  54.   (while (and (not Encontrado) (not (empty? Ops)))
  55.    (setq OpActual (first Ops))
  56.    (setq Ops (rest Ops))
  57.    (if (setq NE (eval (list OpActual (quote EA))))
  58.     (cond
  59.      ((= NE EM) (set 'Encontrado (list OpActual)))
  60.      ((and (not (member NE EdosTrat)) (set 'Encontrado (BusAProf
  61.          (+ Nivel 1) NE EM ROps)))
  62.       (set 'Encontrado (cons OpActual Encontrado))))))Encontrado)
  63.  
  64. (set 'Operadores '(Arriba Izquierda Abajo Derecha))
  65.  
  66. (define (Solucion )
  67.     (set 'E0 '())
  68.   (set 'EF '())
  69.           (prop-color 'I1  254 254 254)
  70.           (prop-color 'I2  254 254 254)
  71.           (prop-color 'I3  254 254 254)
  72.           (prop-color 'I4  254 254 254)
  73.           (prop-color 'I5  254 254 254)
  74.           (prop-color 'I6  254 254 254)
  75.           (prop-color 'I7  254 254 254)
  76.           (prop-color 'I8  254 254 254)
  77.           (prop-color 'I9  254 254 254)
  78.   (set 'E0 (append E0 (list
  79.         (integer (prop-text 'I1))
  80.      (integer (prop-text 'I2))
  81.      (integer (prop-text 'I3))
  82.      (integer (prop-text 'I4))
  83.      (integer (prop-text 'I5))
  84.      (integer (prop-text 'I6))
  85.      (integer (prop-text 'I7))
  86.      (integer (prop-text 'I8))
  87.      (integer (prop-text 'I9)))))
  88.                 (set 'cero (+ (find 0 E0) 1))
  89.                 (eval-string (string (concat "(prop-color 'I" (string cero) " 200 200 200)")))
  90.   (set 'EF (append EF (list
  91.         (integer  (prop-text 'F1))
  92.          (integer (prop-text 'F2))
  93.      (integer (prop-text 'F3))
  94.      (integer (prop-text 'F4))
  95.      (integer (prop-text 'F5))
  96.      (integer (prop-text 'F6))
  97.      (integer (prop-text 'F7))
  98.      (integer (prop-text 'F8))
  99.      (integer (prop-text 'F9)))))
  100.   (prop-text 'S (string (Busca E0 EF))))
  101. (define (Actualiza E)
  102.   (set 'cero (+ (find 0 E) 1))
  103.   (sleep 900)
  104.         (prop-text 'I1 (string (nth 0 E)))
  105.    (prop-text 'I2 (string (nth 1 E)))
  106.    (prop-text 'I3 (string (nth 2 E)))
  107.    (prop-text 'I4 (string (nth 3 E)))
  108.    (prop-text 'I5 (string (nth 4 E)))
  109.    (prop-text 'I6 (string (nth 5 E)))
  110.    (prop-text 'I7 (string (nth 6 E)))
  111.    (prop-text 'I8 (string (nth 7 E)))
  112.    (prop-text 'I9 (string (nth 8 E)))
  113.    (eval-string (string (concat "(prop-color 'I" (string cero) " 200 200 200)")))
  114. )
  115.  
  116. (define (inicio )
  117.   (text-font "Arial" -14 0)
  118.   (win-dialog 'Dialogo 'console 150 150 520 300 "Tarea 2 ::: Puzzle")
  119.   (win-label 'Texto1 'Dialogo 50 20 150 22 "ESTADO INICIAL")
  120.   (win-label 'Texto2 'Dialogo 240 20 150 22 "ESTADO FINAL")
  121.   (win-editline 'I1 'Dialogo 60 50 20 20 "1")
  122.   (win-editline 'I2 'Dialogo 95 50 20 20 "1")
  123.   (win-editline 'I3 'Dialogo 130 50 20 20 "1")
  124.   (win-editline 'I4 'Dialogo 60 80 20 20 "1")
  125.   (win-editline 'I5 'Dialogo 95 80 20 20 "1")
  126.   (win-editline 'I6 'Dialogo 130 80 20 20 "1")
  127.   (win-editline 'I7 'Dialogo 60 110 20 20 "1")
  128.   (win-editline 'I8 'Dialogo 95 110 20 20 "1")
  129.   (win-editline 'I9 'Dialogo 130 110 20 20 "0")
  130.   (win-editline 'F1 'Dialogo 240 50 20 20 "1")
  131.   (win-editline 'F2 'Dialogo 275 50 20 20 "1")
  132.   (win-editline 'F3 'Dialogo 310 50 20 20 "1")
  133.   (win-editline 'F4 'Dialogo 240 80 20 20 "1")
  134.   (win-editline 'F5 'Dialogo 275 80 20 20 "0")
  135.   (win-editline 'F6 'Dialogo 310 80 20 20 "1")
  136.   (win-editline 'F7 'Dialogo 240 110 20 20 "1")
  137.   (win-editline 'F8 'Dialogo 275 110 20 20 "1")
  138.   (win-editline 'F9 'Dialogo 310 110 20 20 "1")
  139.   (win-editline 'S 'Dialogo 40 170 400 22 "")
  140.   (win-label 'Texto3 'Dialogo 40 150 150 22 "SOLUCION:")
  141.   (win-pushbutton 'Solucion 'Dialogo 370 50 70 22 "Solución"
  142.    'Solucion)
  143.   (prop-enabled 'Aplicar 0))
  144.  
  145. (define-macro (local var-list)
  146.   ((append '(lambda ) (list var-list) (rest (args local)))))
  147.  
  148. (define (opsys )
  149.   (cond
  150.    ((primitive? clear-console) 'windows)
  151.    ((primitive? int86)
  152.     (if (primitive? comm-read)
  153.      'dos 'extender))
  154.    ((primitive? registry-read) 'win32)
  155.    (true 'unix)))
  156.  
  157. (define-macro (setq p1 p2)
  158.   (set p1 (eval p2)))

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with @@


Remember me