Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/02/2022 in all areas

  1. ; 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
    3 points
  2. Update the first part ;; Insert Block at Block insertion point - Lee Mac (defun c:insblkcen ( / *error* blk box idx ref sel spc ) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (LM:startundo (LM:acdoc)) (if (and (setq blk (LM:selectifobject "\nSelect block to be inserted: " "INSERT")) (setq blk (LM:name->effectivename (cdr (assoc 2 (entget blk))))) (setq sel (LM:ssget (strcat "\nSelect blocks to insert \"" blk "\" at insertion point: ") '(((0 . "INSERT"))))) (setq spc (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))) ) (repeat (setq idx (sslength sel)) (if (setq ref (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (vla-insertblock spc (vla-get-insertionpoint ref) (vla-get-rotation ref) ) ) ) ) (LM:endundo (LM:acdoc)) (princ) )
    1 point
×
×
  • Create New...