picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

ttt.l (1784B)


      1 # 08feb11abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # *Board
      5 
      6 (load "@lib/simul.l")
      7 
      8 (de display ()
      9    (for Y (3 2 1)
     10       (prinl "   +---+---+---+")
     11       (prin " " Y)
     12       (for X (1 2 3)
     13          (prin " | " (or (get *Board X Y) " ")) )
     14       (prinl " |") )
     15    (prinl "   +---+---+---+")
     16    (prinl "     a   b   c") )
     17 
     18 (de find3 (P)
     19    (find
     20       '((X Y DX DY)
     21          (do 3
     22             (NIL (= P (get *Board X Y)))
     23             (inc 'X DX)
     24             (inc 'Y DY)
     25             T ) )
     26       (1 1 1 1 2 3 1 1)
     27       (1 2 3 1 1 1 1 3)
     28       (1 1 1 0 0 0 1 1)
     29       (0 0 0 1 1 1 1 -1) ) )
     30 
     31 (de myMove ()
     32    (when
     33       (game NIL 8
     34          '((Flg)     # Moves
     35             (unless (find3 (or (not Flg) 0))
     36                (make
     37                   (for (X . L) *Board
     38                      (for (Y . P) L
     39                         (unless P
     40                            (link
     41                               (cons
     42                                  (cons X Y (or Flg 0))
     43                                  (list X Y) ) ) ) ) ) ) ) )
     44          '((Mov) # Move
     45             (set (nth *Board (car Mov) (cadr Mov)) (cddr Mov)) )
     46          '((Flg)     # Cost
     47             (if (find3 (or Flg 0)) -100 0) ) )
     48       (let Mov (caadr @)
     49          (set (nth *Board (car Mov) (cadr Mov)) 0) )
     50       (display) ) )
     51 
     52 (de yourMove (X Y)
     53    (and
     54       (sym? X)
     55       (>= 3 (setq X (- (char X) 96)) 1)
     56       (num? Y)
     57       (>= 3 Y 1)
     58       (not (get *Board X Y))
     59       (set (nth *Board X Y) T)
     60       (display) ) )
     61 
     62 (de main ()
     63    (setq *Board (make (do 3 (link (need 3)))))
     64    (display) )
     65 
     66 (de go Args
     67    (cond
     68       ((not (yourMove (car Args) (cadr Args)))
     69          "Illegal move!" )
     70       ((find3 T) "Congratulation, you won!")
     71       ((not (myMove)) "No moves")
     72       ((find3 0) "Sorry, you lost!") ) )
     73 
     74 # vi:et:ts=3:sw=3