fork(1) download
copy 
  1. ;; ------------------- BOARD 10X10 ---------------------------------
  2. (defun board ()
  3.   "T in position x=0 and y=0"
  4.   '(
  5.     (T 25 54 89 21 8 36 14 41 96) 
  6.     (78 47 56 23 5 NIL 13 12 26 60) 
  7.     (0 27 17 83 34 93 74 52 45 80) 
  8.     (69 9 77 95 55 39 91 73 57 30) 
  9.     (24 15 22 86 1 11 68 79 76 72) 
  10.     (81 48 32 2 64 16 50 37 29 71) 
  11.     (99 51 6 18 53 28 7 63 10 88) 
  12.     (59 42 46 85 90 75 87 43 20 31) 
  13.     (3 61 58 44 65 82 19 4 35 62) 
  14.     (33 70 84 40 66 38 92 67 98 97)
  15.     )
  16. )
  17.  
  18. (defun print-board (board)
  19.    (format T "~%")
  20.    (mapcar (lambda (x) (format T " ~A ~%" x)) board)
  21.    (format nil ""))
  22.  
  23. ;; ------------------- MOVEMENTS -----------------------------------
  24. (defun UP-LEFT (x y board)
  25.   "Function that receives 2 indexes and board, validate movement and move piece up and left"
  26.     (cond
  27.         ((equal (validate-movements (- x 1) (- y 2) board) 0) 
  28.          (move-piece x y -1 -2 board))
  29.         (T nil)))
  30.  
  31. (defun UP-RIGHT (x y board)
  32.   "receive 2 indexes and board, validate movement and move piece up and right"
  33.     (cond
  34.         ((equal (validate-movements (+ x 1) (- y 2) board) 0) 
  35.          (move-piece x y 1 -2 board))
  36.         (T nil)))
  37.  
  38. (defun LEFT-DOWN (x y board)
  39.    "Function that receives 2 indexes and board, validate movement and move piece left and down"
  40.     (cond
  41.         ((equal (validate-movements (- x 2) (+ y 1) board) 0)
  42.          (move-piece x y -2 1 board))
  43.         (T nil)))
  44.  
  45. (defun LEFT-UP (x y board)
  46.    "Function that receives 2 indexes and board, validate movement and move piece left and up"
  47.     (cond
  48.         ((equal (validate-movements (- x 2) (- y 1) board) 0) 
  49.          (move-piece x y -2 -1 board))
  50.         (T nil)))
  51.  
  52. (defun DOWN-RIGHT (x y board)
  53.    "Function that receives 2 indexes and board, validate movement and move piece down and right"
  54.     (cond
  55.         ((equal (validate-movements (+ x 1) (+ y 2) board) 0)
  56.          (move-piece x y 1 2 board))
  57.         (T nil)))
  58. ;; ------------------------- FUNCTIONS THAT VALIDATE MOVEMENTS AND MOVE PIECE
  59. (defun move-piece (x y dx dy board)
  60.  "Function that receives two indexes and board to move the pxece on the board"
  61.   (mapcar 
  62.     (lambda (L) 
  63.       (cond
  64.           ((atom L) L)
  65.           ((and 
  66.                (equal (nth 0 L) x) 
  67.                (equal (nth 1 L) y)) 
  68.                (list (+ (nth 0 L) dx) (+ (nth 1 L) dy) (nth 2 L) 
  69.                      (nth 3 L) (nth 4 L) (nth 5 L) (nth 6 L) 
  70.                      (nth 7 L) (nth 8 L) (nth 9 L)))
  71.     (T L))) board))
  72.  
  73. (defun validate-movements (x y board)   
  74.  "Function that receives two indexes and board to validate movement"
  75.   (cond 
  76.       ((and 
  77.            (>= x 0) 
  78.            (>= y 0) 
  79.            (<= x (nth 9 board)) 
  80.            (<= y (nth 9 board)) 
  81.            (= (apply '+ (mapcar (lambda (L) 
  82.                                        (cond 
  83.                                            ((atom L) 0)
  84.                                            ((or (not(equal (nth 0 L ) x)) (not (equal (nth 1 L) y))) 0) 
  85.                                            (T 1))) board)) 0)) 0)
  86.     (T nil )))
  87.  
  88. ;; ---------------------------- TEST MOVEMENTS ------------------
  89.  
  90. ;;print board
  91. (print-board (board))
  92.  
  93.     ;; test movements
  94. (print-board (DOWN-RIGHT 0 0 (board)))
  95.  
  96.  
Runtime error #stdin #stdout #stderr 0.02s 10324KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
 (T 25 54 89 21 8 36 14 41 96) 
 (78 47 56 23 5 NIL 13 12 26 60) 
 (0 27 17 83 34 93 74 52 45 80) 
 (69 9 77 95 55 39 91 73 57 30) 
 (24 15 22 86 1 11 68 79 76 72) 
 (81 48 32 2 64 16 50 37 29 71) 
 (99 51 6 18 53 28 7 63 10 88) 
 (59 42 46 85 90 75 87 43 20 31) 
 (3 61 58 44 65 82 19 4 35 62) 
 (33 70 84 40 66 38 92 67 98 97)
stderr
copy 
*** - <=: (33 70 84 40 66 38 92 67 98 97) is not a real number
https://ideone.com/jaeCLu
language:
Common Lisp (clisp 2.49.92)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!