exceed Posted May 2, 2022 Share Posted May 2, 2022 (edited) ; 2048 game by autolisp - 2022.05.02 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/ ; command : ; - 2048 (graphic mode) ; - 2048t (command prompt text only mode) ; key : W = up, A = left, S = down, D = right, P = end game ; key2 : 8 = up, 4 = left, 5 = down, 6 = right (for numpad with numlock on), P = end game ; this lisp use your dwg's 15 x 8 space. so you have to run this in new drawing not working dwg. (vl-load-com) (defun c:2048t ( / playlist start newnum *error* graphicmode starttime timer score ) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar 'cmdecho 1) (princ) ) (setq timer 0) (setq starttime (getvar "date")) (setq score 0) (setq playlist (list (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) )) (setq graphicmode 0) (output2048txt playlist) (setq start (getstring "\n 2048 Start (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (exit) ) (play playlist basept) (LM:endundo (LM:acdoc)) (setvar 'cmdecho 1) (princ) ) (defun c:2048 ( / playlist start newnum *error* graphicmode starttime timer score) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar 'cmdecho 1) (princ) ) (setq timer 0) (setq starttime (getvar "date")) (setq score 0) (setq basept (getpoint "\n pick point for 2048 ")) (setq playlist (list (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) )) (setq graphicmode 1) (output2048 playlist basept) (output2048txt playlist) (setq baseptx (car basept)) (setq basepty (cadr basept)) (setq zoompt (list (+ baseptx 15) (+ basepty 8))) (command "_.zoom" "w" basept zoompt) (setq start (getstring "\n 2048 Start (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (exit) ) (play playlist basept) (LM:endundo (LM:acdoc)) (setvar 'cmdecho 1) (princ) ) (defun play ( playlist basept / movement input newplaylist rowlen indexr row collen indexc nonezerolist cell calcindex a b c d nonezerolist2 nowtime ) (setq playlist (makenewnum playlist)) (if (= graphicmode 1) (output2048 playlist basept) ) (output2048txt playlist) (setq input (grread2048)) (cond ((= input "W") (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 3 playlist))) (list (nth 2 (nth 0 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 3 playlist))) (list (nth 1 (nth 0 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 3 playlist))) (list (nth 0 (nth 0 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 3 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 0 (nth 3 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 0 playlist))) (list (nth 1 (nth 3 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 0 playlist))) (list (nth 2 (nth 3 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 0 playlist))) (list (nth 3 (nth 3 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 0 playlist))))) ;(princ "\n input W") (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (play playlist basept) ) ((= input "A") ;(princ "\n input A") (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (play playlist basept) ) ((= input "S") ;(princ "\n input S") (setq playlist (list (list (nth 0 (nth 3 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 0 playlist))) (list (nth 1 (nth 3 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 0 playlist))) (list (nth 2 (nth 3 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 0 playlist))) (list (nth 3 (nth 3 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 0 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 3 playlist))) (list (nth 2 (nth 0 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 3 playlist))) (list (nth 1 (nth 0 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 3 playlist))) (list (nth 0 (nth 0 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 3 playlist))))) (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (play playlist basept) ) ((= input "D") ;(princ "\n input D") (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 2 (nth 0 playlist)) (nth 1 (nth 0 playlist)) (nth 0 (nth 0 playlist))) (list (nth 3 (nth 1 playlist)) (nth 2 (nth 1 playlist)) (nth 1 (nth 1 playlist)) (nth 0 (nth 1 playlist))) (list (nth 3 (nth 2 playlist)) (nth 2 (nth 2 playlist)) (nth 1 (nth 2 playlist)) (nth 0 (nth 2 playlist))) (list (nth 3 (nth 3 playlist)) (nth 2 (nth 3 playlist)) (nth 1 (nth 3 playlist)) (nth 0 (nth 3 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 2 (nth 0 playlist)) (nth 1 (nth 0 playlist)) (nth 0 (nth 0 playlist))) (list (nth 3 (nth 1 playlist)) (nth 2 (nth 1 playlist)) (nth 1 (nth 1 playlist)) (nth 0 (nth 1 playlist))) (list (nth 3 (nth 2 playlist)) (nth 2 (nth 2 playlist)) (nth 1 (nth 2 playlist)) (nth 0 (nth 2 playlist))) (list (nth 3 (nth 3 playlist)) (nth 2 (nth 3 playlist)) (nth 1 (nth 3 playlist)) (nth 0 (nth 3 playlist))))) (play playlist basept) ) ((= input "P") ;(princ "\n input P") (princ "\n your time lap is ") (princ timer) (princ "\n your score is ") (princ score) (if (= graphicmode 1) (progn (setq delyn (getstring "\n you want to delete game board? (Press Anykey - Yes / N - No)")) (if (/= (strcase delyn) "N") (progn (if (/= ss2048 nil) (command "_.Erase" ss2048 "") ) (if (/= ss22048 nil) (command "_.Erase" ss22048 "") ) (if (/= ss32048 nil) (command "_.Erase" ss32048 "") ) (if (/= ss42048 nil) (command "_.Erase" ss42048 "") ) );end of progn );end of if );end of progn );end of if ); end of "p" );end of cond ) (defun output2048txt ( lst / adjust lstlen indexr row rowlen indexc cell celllen delta ) (setq adjust 10) (setq lstlen (length lst)) (setq indexr 0) (setq score 0) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq indexc 0) (repeat rowlen (setq cellnum (nth indexc row)) (setq score (+ score cellnum)) (setq cell (vl-princ-to-string cellnum)) (if (= cell nil) (setq cell 0)) (setq celllen (strlen cell)) (setq delta (- adjust celllen)) (repeat delta (setq cell (strcat cell " ")) ) (princ cell) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat (princ "\n Waiting User Input - ") );end of output2048txt (defun output2048 ( lst basept / adjust lstlen indexr row rowlen indexc cell celllen delta basept baseptx basepty ptlist ptrow ptcell ptcellx ptcelly cellnum ) (setq adjust 10) (setq lstlen (length lst)) (setq indexr 0) (if (/= ss2048 nil) (command "_.Erase" ss2048 "") ) (setq ss2048 (ssadd)) (if (/= ss22048 nil) (command "_.Erase" ss22048 "") ) (setq ss22048 (ssadd)) (if (/= ss32048 nil) (command "_.Erase" ss32048 "") ) (setq ss32048 (ssadd)) (if (/= ss42048 nil) (command "_.Erase" ss42048 "") ) (setq ss42048 (ssadd)) (setq baseptx (car basept)) (setq basepty (cadr basept)) (setq ptlist (list (list (list (+ baseptx 0) (+ basepty 6)) (list (+ baseptx 2) (+ basepty 6)) (list (+ baseptx 4) (+ basepty 6)) (list (+ baseptx 6) (+ basepty 6))) (list (list (+ baseptx 0) (+ basepty 4)) (list (+ baseptx 2) (+ basepty 4)) (list (+ baseptx 4) (+ basepty 4)) (list (+ baseptx 6) (+ basepty 4))) (list (list (+ baseptx 0) (+ basepty 2)) (list (+ baseptx 2) (+ basepty 2)) (list (+ baseptx 4) (+ basepty 2)) (list (+ baseptx 6) (+ basepty 2))) (list (list (+ baseptx 0) (+ basepty 0)) (list (+ baseptx 2) (+ basepty 0)) (list (+ baseptx 4) (+ basepty 0)) (list (+ baseptx 6) (+ basepty 0))) )) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq ptrow (nth indexr ptlist)) (setq indexc 0) (repeat rowlen (setq cellnum (nth indexc row)) (setq cell (vl-princ-to-string cellnum)) (setq ptcell (nth indexc ptrow)) (setq ptcellx (car ptcell)) (setq ptcelly (cadr ptcell)) (if (= cell nil) (setq cell 0)) (setq celllen (strlen cell)) (setq delta (- adjust celllen)) (repeat delta (setq cell (strcat cell " ")) ) (cond ((= cellnum 0) (setq colorcode 7) (setq cellnum " ")) ((= cellnum 2) (setq colorcode 81)) ((= cellnum 4) (setq colorcode 71)) ((= cellnum 8) (setq colorcode 61)) ((= cellnum 16) (setq colorcode 51)) ((= cellnum 32) (setq colorcode 41)) ((= cellnum 64) (setq colorcode 31)) ((= cellnum 128) (setq colorcode 21)) ((= cellnum 256) (setq colorcode 11)) ((= cellnum 512) (setq colorcode 10)) ((= cellnum 1024) (setq colorcode 12)) ((= cellnum 2048) (setq colorcode 14)) ((> cellnum 2048) (setq colorcode 6)) );end of cond (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 colorcode) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 0.5) (cons 1 (vl-princ-to-string cellnum)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ ptcellx 1) (+ ptcelly 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) ss2048) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 colorcode) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ ptcellx 0.05) (+ ptcelly 0.05))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ ptcellx 1.95) (+ ptcelly 0.05))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ ptcellx 1.95) (+ ptcelly 1.95))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ ptcellx 0.05) (+ ptcelly 1.95))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss22048) (if (= timer nil) (setq timer 0)) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 0.5) (cons 1 (strcat "Timer : " (rtos timer 2 2) " sec")) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 0) (cons 10 (list (+ baseptx 9) (+ basepty 6) 0)) (cons 100 "AcDbText") (cons 73 0))) (ssadd (entlast) ss32048) (if (= score nil) (setq score 0)) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 0.5) (cons 1 (strcat "Score : " (rtos score 2 0) )) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 0) (cons 10 (list (+ baseptx 9) (+ basepty 4) 0)) (cons 100 "AcDbText") (cons 73 0))) (ssadd (entlast) ss42048) ;(princ cell) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat ;(princ "\n Waiting User Input - ") );end of output2048 (defun makenewnum ( lst / rowlen indexr zerolist row collen indexc cell remainzero newnum newspace replacerow replacecol newrowlist ) (setq rowlen (length lst)) (setq indexr 0) (setq zerolist '()) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (setq indexc 0) (repeat collen (setq cell (nth indexc row)) (if (= cell 0) (setq zerolist (cons (list indexr indexc) zerolist)) ) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat ;(princ zerolist) (setq remainzero (length zerolist)) (if (= remainzero 0) (progn (princ "\n There's no space for new number") (princ "\n Game Over ") (exit) ) (progn (setq newnum (* (LM:randrange 1 2) 2)) (setq newspace (nth (- (LM:randrange 1 remainzero) 1) zerolist)) (setq replacerow (car newspace)) (setq replacecol (cadr newspace)) (setq indexr 0) (setq newlist '()) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (setq indexc 0) (setq newrowlist '()) (repeat collen (if (and (= indexc replacecol) (= indexr replacerow)) (progn (setq cell newnum) (setq newrowlist (cons cell newrowlist))) (progn (setq cell (nth indexc row)) (setq newrowlist (cons cell newrowlist))) ) (setq indexc (+ indexc 1)) ); end of repeat (setq newrowlist (reverse newrowlist)) (setq newlist (cons newrowlist newlist)) (setq indexr (+ indexr 1)) ); end of repeat ); end of progn );end of if (setq newlist (reverse newlist)) newlist );end of makenewnum ; by Kent1Cooper, https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-arrow-keys-sending-input-without-enter-and-returning-to/m-p/5371933/highlight/true#M327188 (defun grread2048 (/ done) (setq done nil) (while (and (not done) (setq opt (grread T 12 0))) (cond ((or (equal opt '(2 87)) (equal opt '(2 119)) (equal opt '(2 56))) ; input W (setq done T) (princ "\ Input Up (W)") (setq movement "W") ) ((or (equal opt '(2 65)) (equal opt '(2 97)) (equal opt '(2 52))) ; input A (setq done T) (princ "\ Input Left (A)") (setq movement "A") ) ((or (equal opt '(2 83)) (equal opt '(2 115)) (equal opt '(2 53))) ; input S (setq done T) (princ "\ Input Down (S)") (setq movement "S") ) ((or (equal opt '(2 68)) (equal opt '(2 100)) (equal opt '(2 54))) ; input D (setq done T) (princ "\ Input Right (D)") (setq movement "D") ) ((or (equal opt '(2 80)) (equal opt '(2 112))) ; input P (setq done T) (princ "\ Input End (P)") (setq movement "P") ) ); cond ); while movement );end of defun ;; Rand - Lee Mac ;; PRNG implementing a linear congruential generator with ;; parameters derived from the book 'Numerical Recipes' (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) ;; Random in Range - Lee Mac ;; Returns a pseudo-random integral number in a given range (inclusive) (defun LM:randrange ( a b ) (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b)))))) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) yes this is 2048 game for fun ( https://en.wikipedia.org/wiki/2048_(video_game) ) this is my grread practice code. command : - 2048 (graphic mode - use polyline and text) - 2048t (command prompt text only mode) Key : W = up , A = left , S = down, D = right, P = end game Key2 : 8 = up, 4 = left, 5 = down, 6 = right (for numpad with numlock on), P = end game If you can no longer generate numbers, it will be game over (but there seems to be some error haha) ------------------------------------------------------------------------ At first, I was going to practice grread simply, but it seems that I studied the algorithm of moving and adding in 4 directions more and more. Create a function for one direction, rotate the 4x4 matrix in 3 directions, apply it and back again. If it was implemented universally in this process, it would have been possible to freely create 5x5, 10x10, etc. not only 4x4, but it was difficult so I hard coding that. So it only works for 4x4 sadly Edited May 3, 2022 by exceed add graphic mode, add timer and score, can pick point for game, add vl-load-com, add P button for end, add startundo endundo, close the polyline 3 1 Quote Link to comment Share on other sites More sharing options...
ekko Posted May 2, 2022 Share Posted May 2, 2022 17 minutes ago, exceed said: ; 2048 game by autolisp - 2022.05.02 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/ (defun c:2048 ( / playlist start newnum ) (setq playlist (list (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) )) (output2048 playlist) (setq start (getstring "\n 2048 Start (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (exit) ) (play playlist) (princ) ) (defun play ( playlist / movement input newplaylist rowlen indexr row collen indexc nonezerolist cell calcindex a b c d nonezerolist2 ) (setq playlist (makenewnum playlist)) (output2048 playlist) (setq input (grread2048)) (cond ((= input "W") (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 3 playlist))) (list (nth 2 (nth 0 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 3 playlist))) (list (nth 1 (nth 0 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 3 playlist))) (list (nth 0 (nth 0 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 3 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 0 (nth 3 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 0 playlist))) (list (nth 1 (nth 3 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 0 playlist))) (list (nth 2 (nth 3 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 0 playlist))) (list (nth 3 (nth 3 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 0 playlist))))) ;(princ "\n input W") (play playlist) ) ((= input "A") ;(princ "\n input A") (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (play playlist) ) ((= input "S") ;(princ "\n input S") (setq playlist (list (list (nth 0 (nth 3 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 0 playlist))) (list (nth 1 (nth 3 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 0 playlist))) (list (nth 2 (nth 3 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 0 playlist))) (list (nth 3 (nth 3 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 0 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 3 playlist))) (list (nth 2 (nth 0 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 3 playlist))) (list (nth 1 (nth 0 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 3 playlist))) (list (nth 0 (nth 0 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 3 playlist))))) (play playlist) ) ((= input "D") ;(princ "\n input D") (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 2 (nth 0 playlist)) (nth 1 (nth 0 playlist)) (nth 0 (nth 0 playlist))) (list (nth 3 (nth 1 playlist)) (nth 2 (nth 1 playlist)) (nth 1 (nth 1 playlist)) (nth 0 (nth 1 playlist))) (list (nth 3 (nth 2 playlist)) (nth 2 (nth 2 playlist)) (nth 1 (nth 2 playlist)) (nth 0 (nth 2 playlist))) (list (nth 3 (nth 3 playlist)) (nth 2 (nth 3 playlist)) (nth 1 (nth 3 playlist)) (nth 0 (nth 3 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 2 (nth 0 playlist)) (nth 1 (nth 0 playlist)) (nth 0 (nth 0 playlist))) (list (nth 3 (nth 1 playlist)) (nth 2 (nth 1 playlist)) (nth 1 (nth 1 playlist)) (nth 0 (nth 1 playlist))) (list (nth 3 (nth 2 playlist)) (nth 2 (nth 2 playlist)) (nth 1 (nth 2 playlist)) (nth 0 (nth 2 playlist))) (list (nth 3 (nth 3 playlist)) (nth 2 (nth 3 playlist)) (nth 1 (nth 3 playlist)) (nth 0 (nth 3 playlist))))) (play playlist) ) );end of cond ) (defun output2048 ( lst / adjust lstlen indexr row rowlen indexc cell celllen delta ) (setq adjust 10) (setq lstlen (length lst)) (setq indexr 0) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq indexc 0) (repeat rowlen (setq cell (vl-princ-to-string (nth indexc row))) (if (= cell nil) (setq cell 0)) (setq celllen (strlen cell)) (setq delta (- adjust celllen)) (repeat delta (setq cell (strcat cell " ")) ) (princ cell) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat (princ "\n Waiting User Input - ") );end of output2048 (defun makenewnum ( lst / rowlen indexr zerolist row collen indexc cell remainzero newnum newspace replacerow replacecol newrowlist ) (setq rowlen (length lst)) (setq indexr 0) (setq zerolist '()) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (setq indexc 0) (repeat collen (setq cell (nth indexc row)) (if (= cell 0) (setq zerolist (cons (list indexr indexc) zerolist)) ) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat ;(princ zerolist) (setq remainzero (length zerolist)) (if (= remainzero 0) (progn (princ "\n There's no space for new number") (princ "\n Game Over ") (exit) ) (progn (setq newnum (* (LM:randrange 1 2) 2)) (setq newspace (nth (- (LM:randrange 1 remainzero) 1) zerolist)) (setq replacerow (car newspace)) (setq replacecol (cadr newspace)) (setq indexr 0) (setq newlist '()) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (setq indexc 0) (setq newrowlist '()) (repeat collen (if (and (= indexc replacecol) (= indexr replacerow)) (progn (setq cell newnum) (setq newrowlist (cons cell newrowlist))) (progn (setq cell (nth indexc row)) (setq newrowlist (cons cell newrowlist))) ) (setq indexc (+ indexc 1)) ); end of repeat (setq newrowlist (reverse newrowlist)) (setq newlist (cons newrowlist newlist)) (setq indexr (+ indexr 1)) ); end of repeat ); end of progn );end of if (setq newlist (reverse newlist)) newlist );end of makenewnum ; by Kent1Cooper, https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-arrow-keys-sending-input-without-enter-and-returning-to/m-p/5371933/highlight/true#M327188 (defun grread2048 (/ done) (setq done nil) (while (and (not done) (setq opt (grread T 12 0))) (cond ((or (equal opt '(2 87)) (equal opt '(2 119))) ; input W (setq done T) (princ "\ Input Up (W)") (setq movement "W") ) ((or (equal opt '(2 65)) (equal opt '(2 97))) ; input A (setq done T) (princ "\ Input Left (A)") (setq movement "A") ) ((or (equal opt '(2 83)) (equal opt '(2 115))) ; input S (setq done T) (princ "\ Input Down (S)") (setq movement "S") ) ((or (equal opt '(2 68)) (equal opt '(2 100))) ; input D (setq done T) (princ "\ Input Right (D)") (setq movement "D") ) ); cond ); while movement );end of defun ;; Rand - Lee Mac ;; PRNG implementing a linear congruential generator with ;; parameters derived from the book 'Numerical Recipes' (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) ;; Random in Range - Lee Mac ;; Returns a pseudo-random integral number in a given range (inclusive) (defun LM:randrange ( a b ) (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b)))))) ) yes this is 2048 game for fun ( https://en.wikipedia.org/wiki/2048_(video_game) ) this is my grread practice code. command : 2048 Key : W = up , A = left , S = down, D = right It would be good - decorated with blocks & hatches - add lap time or score points. If you can no longer generate numbers, it will be game over (but there seems to be some error haha) This is a very interesting and creative example. 1 Quote Link to comment Share on other sites More sharing options...
exceed Posted May 3, 2022 Author Share Posted May 3, 2022 (edited) When I woke up, I realized that what I couldn't solve yesterday was a simple problem, so today I tried to make it. This code is what I needed in the 2048 code = Rotate or Flip any size of matrix. not only 4x4 I think, since this is a common function, there is a code that was created by others. but I couldn't find an appropriate keyword because my english was not good. - In the case of Flip, it is more concise to just use (reverse columnlist) or (reverse rowlist), but I wanted to make it according to the structure used. ; Rotate or Mirror a matrix - 2022.05.03 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/?do=findComment&comment=594432 ; how to use = (ex:rotatematrix list direction) ; list = matrix to rotate, list in list format like ((a b c d) (e f g h) (i j k l) (m n o p)) ; direction = ; "0", "90", "180", "270" - Enter the angle to rotate in string format ; "HFLIP", "VFLIP" - Horizontal or Vertical Flip ; ; There is a function to check if it is a matrix. ; ; Test Command ; 1. rotatetest - 4x5 matrix test ; 2. returntest - run twice to get back to original matrix ; 3. 50x50test - 50x50 matrix test (vl-load-com) (defun c:rotatetest ( / inputlist outputlist ) (setq inputlist (list (list "1a" "1b" "1c" "1d" "1e") (list "2a" "2b" "2c" "2d" "2e") (list "3a" "3b" "3c" "3d" "3e") (list "4a" "4b" "4c" "4d" "4e"))) (princ "\n Input List - ") (princ inputlist) (setq outputlist (ex:rotatematrix inputlist "0")) (princ "\n Output List - Rotated 0 deg (nothing happened) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "90")) (princ "\n Output List - Rotated 90 deg (Leftside -> Downside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "180")) (princ "\n Output List - Rotated 180 deg (Leftside -> Rightside (not a flip)) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "270")) (princ "\n Output List - Rotated 270 deg (leftside -> upside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "HFLIP")) (princ "\n Output List - Horizontal Flip (Mirror the Columns) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "VFLIP")) (princ "\n Output List - Vertical Flip (Mirrir ther Rows) - ") (princ outputlist) (princ) );end of defun (defun c:returntest ( / inputlist outputlist ) (setq inputlist (list (list "1a" "1b" "1c" "1d" "1e") (list "2a" "2b" "2c" "2d" "2e") (list "3a" "3b" "3c" "3d" "3e") (list "4a" "4b" "4c" "4d" "4e"))) (princ "\n Input List - ") (princ inputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "90") "270")) (princ "\n Output List - Rotated 90->270 deg (leftside -> downside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "270") "90")) (princ "\n Output List - Rotated 270->90 deg (leftside -> upside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "180") "180")) (princ "\n Output List - Rotated 180->180 deg (leftside -> rightside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "HFLIP") "HFLIP")) (princ "\n Output List - Horizontal Flip -> Horizontal Flip - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "VFLIP") "VFLIP")) (princ "\n Output List - Vertical Flip -> Vertical Flip - ") (princ outputlist) (princ) );end of defun (defun c:50x50test ( / inputlist outputlist index1 index2 testcell testrow ) (setq index1 1) (setq inputlist '()) (repeat 50 (setq testrow '()) (setq index2 1) (repeat 50 (setq testcell (strcat (vl-princ-to-string index1) "-" (vl-princ-to-string index2))) (setq testrow (cons testcell testrow)) (setq index2 (+ index2 1)) );end of repeat (setq inputlist (cons (reverse testrow) inputlist)) (setq index1 (+ index1 1)) );end of repeat (setq inputlist (reverse inputlist)) (princ "\n Input List - ") (princ inputlist) (setq outputlist (ex:rotatematrix inputlist "0")) (princ "\n Output List - Rotated 0 deg (Not Rotated) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "90")) (princ "\n Output List - Rotated 90 deg (Leftside -> Downside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "180")) (princ "\n Output List - Rotated 180 deg (Leftside -> Rightside (not a flip)) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "270")) (princ "\n Output List - Rotated 270 deg (leftside -> upside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "HFLIP")) (princ "\n Output List - Horizontal Flip (Mirror the Columns) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "VFLIP")) (princ "\n Output List - Vertical Flip (Mirrir ther Rows) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "90") "270")) (princ "\n Output List - Rotated 90->270 deg (leftside -> downside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "270") "90")) (princ "\n Output List - Rotated 270->90 deg (leftside -> upside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "180") "180")) (princ "\n Output List - Rotated 180->180 deg (leftside -> rightside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "HFLIP") "HFLIP")) (princ "\n Output List - Horizontal Flip -> Horizontal Flip - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "VFLIP") "VFLIP")) (princ "\n Output List - Vertical Flip -> Vertical Flip - ") (princ outputlist) (princ) );end of defun (defun ex:rotatematrix (lst deg / rowlen oldcollen indexr checkflag row collen indexc rowlist cell ) ; check matrix (setq rowlen (length lst)) (setq oldcollen (length (nth 0 lst))) (setq indexr 0) (setq checkflag 0) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (if (/= collen oldcollen) (setq checkflag 1) ) (setq oldcollen collen) (setq indexr (+ indexr 1)) );end of repeat (if (/= checkflag 1) (progn (cond ((= deg "90") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat collen (setq indexc 0) (setq rowlist '()) (repeat rowlen (setq cell (nth (- (- collen 1) indexr) (nth indexc lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case1 90 ((= deg "180") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat rowlen (setq indexc 0) (setq rowlist '()) (repeat collen (setq cell (nth (- (- collen 1) indexc) (nth (- (- rowlen 1) indexr) lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case2 180 ((= deg "270") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat collen (setq indexc 0) (setq rowlist '()) (repeat rowlen (setq cell (nth indexr (nth (- (- rowlen 1) indexc) lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case3 270 ((= deg "HFLIP") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat rowlen (setq indexc 0) (setq rowlist '()) (repeat collen (setq cell (nth (- (- collen 1) indexc) (nth indexr lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case4 horizontal flip ((= deg "VFLIP") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat rowlen (setq indexc 0) (setq rowlist '()) (repeat collen (setq cell (nth indexc (nth (- (- rowlen 1) indexr) lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case2 180 ((= deg "0") (setq outputlist lst) );end of cond case2 180 );end of cond outputlist );end of progn (progn (princ "\n It's not a Matrix - The number of columns in Row ") (princ indexr) (princ " is different from the other Rows.") (exit) );end of progn );end of if );end of defun Command: ROTATEMATRIX Input List - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 0 deg (Not Rotated) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 90 deg (Leftside -> Downside) - ((1e 2e 3e 4e) (1d 2d 3d 4d) (1c 2c 3c 4c) (1b 2b 3b 4b) (1a 2a 3a 4a)) Output List - Rotated 180 deg (Leftside -> Rightside (not a flip)) - ((4e 4d 4c 4b 4a) (3e 3d 3c 3b 3a) (2e 2d 2c 2b 2a) (1e 1d 1c 1b 1a)) Output List - Rotated 270 deg (leftside -> upside) - ((4a 3a 2a 1a) (4b 3b 2b 1b) (4c 3c 2c 1c) (4d 3d 2d 1d) (4e 3e 2e 1e)) Output List - Horizontal Flip (Mirror the Columns) - ((1e 1d 1c 1b 1a) (2e 2d 2c 2b 2a) (3e 3d 3c 3b 3a) (4e 4d 4c 4b 4a)) Output List - Vertical Flip (Mirrir ther Rows) - ((4a 4b 4c 4d 4e) (3a 3b 3c 3d 3e) (2a 2b 2c 2d 2e) (1a 1b 1c 1d 1e)) Command: RETURNTEST Input List - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 90->270 deg (leftside -> downside -> leftside) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 270->90 deg (leftside -> upside -> leftside) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 180->180 deg (leftside -> rightside -> leftside) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Horizontal Flip -> Horizontal Flip - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Vertical Flip -> Vertical Flip - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Edited May 3, 2022 by exceed 1 1 Quote Link to comment Share on other sites More sharing options...
exceed Posted May 10, 2022 Author Share Posted May 10, 2022 (edited) this is Tower of hanoi game ( https://en.wikipedia.org/wiki/Tower_of_Hanoi ) almost same as 2048 ; Tower of Hanoi game by autolisp - 2022.05.10 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/ ; command : ; - HANOI (graphic mode) ; - HANOIT (command prompt text only mode) ; key : A = Pick or Place 1st Pole, S = Pick or Place 2nd Pole, D = Pick or Place 3rd Pole, P = end game ; key : 1 = Pick or Place 1st Pole, 2 = Pick or Place 2nd Pole, 3 = Pick or Place 3rd Pole, 9 = end game ; this lisp use your dwg's space. so you have to run this in new drawing not working dwg. (defun c:HANOIT ( / playcount mover) (setq playcount 0) (setq mover 0) (ex:hanoi 2 0) ) (defun c:HANOI ( / playcount mover) (setq playcount 0) (setq mover 0) (ex:hanoi 2 1) ) (defun ex:hanoi ( level graphicmode / *error* timer starttime score level aindex alist blist clist playlist ) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar 'cmdecho 1) (princ) ) (setq timer 0) (setq starttime (getvar "date")) (setq score 0) (initget 7) (if (= level nil) (setq level (getint "\n set level"))) (setq aindex 0) (setq alist (list "A")) (setq blist (list "B")) (setq clist (list "C")) (repeat level (setq alist (cons (- level aindex) alist)) (setq aindex (+ aindex 1)) );end of repeat (setq playlist (list (reverse alist) (reverse blist) (reverse clist))) (if (= graphicmode 0) (progn (setq basept (list 0 0 0)) ) (progn (if (= playcount 0) (setq basept (getpoint "\n pick point for game")) ) ) );end of if (outputhanoitxt playlist) (setq start (getstring "\n Start Towers of Hanoi (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (progn (princ "\n your time lap is ") (princ timer) (if (= graphicmode 1) (progn (setq delyn (getstring "\n you want to delete game board? (Press Anykey - Yes / N - No)")) (if (/= (strcase delyn) "N") (progn (if (/= sshanoi nil) (command "_.Erase" sshanoi "") ) );end of progn );end of if );end of progn );end of if (exit) );end of progn ) (setq pickhanoi 0) (play playlist basept) (LM:endundo (LM:acdoc)) (setvar 'cmdecho 1) (princ) ) (defun ex:toplist ( playlist / plates1st plates2nd plates3rd p1last index p1len p1atom p2last p2len p2atom p3last p3len p3atom ) (setq p1last (last (car playlist))) (setq p2last (last (cadr playlist))) (setq p3last (last (caddr playlist))) (if (= p1last "A") (setq p1last (* 2 level))) (if (= p2last "B") (setq p2last (* 2 level))) (if (= p3last "C") (setq p3last (* 2 level))) (list p1last p2last p3last) ) (defun play ( playlist basept / nextlev movement input newplaylist rowlen indexr row collen indexc nonezerolist cell calcindex a b c d nonezerolist2 nowtime ) (outputhanoitxt playlist) (if (= (length (caddr playlist)) (+ level 1)) (progn (princ "\n Level ") (princ level) (princ " Complete") (princ " - your time lap is ") (princ timer) (princ " / movement is ") (princ mover) (princ " / ") (princ (- (expt 2 level) 1)) (setq nextlev (getstring "\n Go to the Next Level - Press Any Key")) (setq level (+ level 1)) (setq mover 0) (setq playcount (+ playcount 1)) (ex:hanoi level graphicmode) );end of progn );end of if (setq input (grreadhanoi)) (cond ((= input "A") (setq toplist (ex:toplist playlist)) (princ "\n toplist - ") (princ toplist) (cond ((/= pickhanoi 0) (princ "\n place mode - from ") (princ pickhanoi) (princ " pole - ") (princ picker) (setq newalist '()) (if (>= (car toplist) picker) (progn (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) );end of progn (progn (princ "\n cannot place it") (cond ((= pickhanoi 1) (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 2) (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 3) (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ) ) );end of if (setq pickhanoi 0) ) ((= pickhanoi 0) (princ "\n pick mode - ") (setq picker (car toplist)) (if (< picker (+ level 1)) (progn (princ (car playlist)) (princ picker) (princ " selected") (setq index1 0) (setq newalist '()) (repeat (- (length (car playlist)) 1) (setq a1 (nth index1 (car playlist))) (setq newalist (cons a1 newalist)) (setq index1 (+ index1 1)) ) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq mover (+ mover 1)) (setq pickhanoi 1) (if (= graphicmode 1) (progn (setq sshanoi2 (ssadd)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi2) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string picker)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ baseptx 2) (/ maxplatex 2)) (- (+ (+ basepty (* level 2)) 6) 1) 2)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi2) );end of progn );end of if );end of progn (princ "\n cannot pick that, because there is no plate") );end of if ) );end of cond (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (play playlist basept) ) ((= input "S") (setq toplist (ex:toplist playlist)) (princ "\n toplist - ") (princ toplist) (cond ((/= pickhanoi 0) (princ "\n place mode - from ") (princ pickhanoi) (princ " pole - ") (princ picker) (setq newalist '()) (if (>= (cadr toplist) picker) (progn (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) );end of progn (progn (princ "\n cannot place it") (cond ((= pickhanoi 1) (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 2) (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 3) (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ) ) );end of if (setq pickhanoi 0) ) ((= pickhanoi 0) (princ "\n pick mode - ") (setq picker (cadr toplist)) (if (< picker (+ level 1)) (progn (princ (cadr playlist)) (princ picker) (princ " selected") (setq index1 0) (setq newalist '()) (repeat (- (length (cadr playlist)) 1) (setq a1 (nth index1 (cadr playlist))) (setq newalist (cons a1 newalist)) (setq index1 (+ index1 1)) ) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 2) (setq mover (+ mover 1)) (if (= graphicmode 1) (progn (setq sshanoi2 (ssadd)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi2) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string picker)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) (+ maxplatex 4)) (- (+ (+ basepty (* level 2)) 6) 1) 2)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi2) );end of progn );end of if );end of progn (princ "\n cannot pick that, because there is no plate") );end of if ) );end of cond (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (play playlist basept) ) ((= input "D") (setq toplist (ex:toplist playlist)) (princ "\n toplist - ") (princ toplist) (cond ((/= pickhanoi 0) (princ "\n place mode - from ") (princ pickhanoi) (princ " pole - ") (princ picker) (setq newalist '()) (if (>= (caddr toplist) picker) (progn (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) );end of progn (progn (princ "\n cannot place it") (cond ((= pickhanoi 1) (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 2) (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 3) (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ) ) );end of if (setq pickhanoi 0) ) ((= pickhanoi 0) (princ "\n pick mode - ") (setq picker (caddr toplist)) (if (< picker (+ level 1)) (progn (princ (caddr playlist)) (princ picker) (princ " selected") (setq index1 0) (setq newalist '()) (repeat (- (length (caddr playlist)) 1) (setq a1 (nth index1 (caddr playlist))) (setq newalist (cons a1 newalist)) (setq index1 (+ index1 1)) ) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 3) (setq mover (+ mover 1)) (if (= graphicmode 1) (progn (setq sshanoi2 (ssadd)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi2) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string picker)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) (+ (* maxplatex 2) 8)) (- (+ (+ basepty (* level 2)) 6) 1) 2)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi2) );end of progn );end of if );end of progn (princ "\n cannot pick that, because there is no plate") );end of if ) );end of cond (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (play playlist basept) ) ((= input "P") ;(princ "\n input P") (princ "\n your time lap is ") (princ timer) (princ " / movement is ") (princ mover) (if (= graphicmode 1) (progn (setq delyn (getstring "\n you want to delete game board? (Press Anykey - Yes / N - No)")) (if (/= (strcase delyn) "N") (progn (if (/= sshanoi nil) (command "_.Erase" sshanoi "") ) );end of progn );end of if );end of progn );end of if ); end of "p" );end of cond ) (defun outputhanoitxt ( lst / adjust lstlen indexr row rowlen indexc cell celllen delta outonlylist ) (setq adjust 10) (if (/= sshanoi nil) (command "_.Erase" sshanoi "") ) (setq sshanoi (ssadd)) (setq outonlylist (ex:rotatematrixforhanoi lst "90")) (setq lstlen (length outonlylist)) (setq indexr 0) (repeat lstlen (princ "\n") (setq row (nth indexr outonlylist)) (setq rowlen (length row)) (setq indexc 0) (repeat rowlen (setq cellnum (nth indexc row)) (setq cell (vl-princ-to-string cellnum)) (if (= cell nil) (setq cell 0)) (setq celllen (strlen cell)) (setq delta (- adjust celllen)) (repeat delta (setq cell (strcat cell " ")) ) (princ cell) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat (if (= graphicmode 1) (progn (setq baseptx (car basept)) (setq basepty (cadr basept)) (setq maxplatex (+ 2 (* level 2))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ baseptx 0) (+ basepty 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ (* maxplatex 3) 12)) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ (* maxplatex 3) 12)) (+ basepty 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (setq xgap (+ maxplatex 4)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (setq xgap2 (* xgap 2)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap2) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap2) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap2) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap2) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (if (= (rem (+ (length (car lst)) 1) 2) 0) (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Even") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ baseptx 2) (/ maxplatex 2)) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Odd") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ baseptx 2) (/ maxplatex 2)) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (if (= (rem (+ (length (cadr lst)) 1) 2) 0) (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Even") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Odd") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (if (= (rem (+ (length (caddr lst)) 1) 2) 0) (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Even") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap2) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Odd") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap2) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (setq indexr 0) (setq xstack (+ baseptx (+ 2 (/ maxplatex 2)))) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq indexc 0) (setq ystack basepty) (repeat rowlen (setq cellnum (nth indexc row)) (if (and (/= cellnum " ") (/= cellnum "A") (/= cellnum "B") (/= cellnum "C")) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 cellnum) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (- xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (- xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 cellnum) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string cellnum)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ xstack 0) (+ ystack 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (setq ystack (+ ystack 2)) (setq indexc (+ indexc 1)) );end of repeat (setq xstack (+ xstack (+ 4 maxplatex))) (setq indexr (+ indexr 1)) );end of repeat );end of progn );end of if (command "_.Zoom" "O" sshanoi "") (princ "\n Waiting User Input - ") ) (defun ex:rotatematrixforhanoi (lst deg / rowlen oldcollen indexr checkflag row collen indexc rowlist cell topcollen ) ; check matrix (setq rowlen (length lst)) (setq oldcollen (length (nth 0 lst))) (setq indexr 0) (setq checkflag 0) (if (/= checkflag 1) (progn (cond ((= deg "90") (setq rowlen (length lst)) (setq collen (+ level 1)) (setq indexr 0) (setq outputlist '()) (repeat collen (setq indexc 0) (setq rowlist '()) (repeat rowlen (setq cell (nth (- (- collen 1) indexr) (nth indexc lst))) (if (= cell nil) (setq cell " ")) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case1 90 );end of cond outputlist );end of progn (progn (princ "\n It's not a Matrix - The number of columns in Row ") (princ indexr) (princ " is different from the other Rows.") (princ lst) (exit) );end of progn );end of if );end of defun ; by Kent1Cooper, https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-arrow-keys-sending-input-without-enter-and-returning-to/m-p/5371933/highlight/true#M327188 (defun grreadhanoi (/ done) (setq done nil) (while (and (not done) (setq opt (grread T 12 0))) (cond ((or (equal opt '(2 65)) (equal opt '(2 97)) (equal opt '(2 49))) ; input A (setq done T) (princ "\ Input Left (A)") (setq movement "A") ) ((or (equal opt '(2 83)) (equal opt '(2 115)) (equal opt '(2 50))) ; input S (setq done T) (princ "\ Input Down (S)") (setq movement "S") ) ((or (equal opt '(2 68)) (equal opt '(2 100)) (equal opt '(2 51))) ; input D (setq done T) (princ "\ Input Right (D)") (setq movement "D") ) ((or (equal opt '(2 80)) (equal opt '(2 112)) (equal opt '(2 57))) ; input P (setq done T) (princ "\ Input End (P)") (setq movement "P") ) ); cond ); while movement );end of defun ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) command list HANOI - graphic mode HANOIT - text mode key set (A) a - pick or place 1st pole s - pick or place 2nd pole d - pick or place 3rd pole p - end game or key set (b) 1 - pick or place 1st pole 2 - pick or place 2nd pole 3 - pick or place 3rd pole 9 - end game Edited May 10, 2022 by exceed 2 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.