绘图者游戏
工作（草稿）更多，代码更少。。。我必须做点什么来激励自己在绘图上多做些工作，不要被编码分心。
那么我的解决方案是什么
我写了一个生成ranklist的例程，当我画更多的时候（使用命令调用或lisp调用），它会增加我的秩-多么讽刺。
编写（汇编）该代码很有趣，其目的是提高绘图效率。
然而，我没有经过测试，所以我不知道对于每一个困难，分数是太多还是太少，以及它会有多上瘾-只是想实现我的这个想法。
; --- -----------------------------------------------------------------------------
; Drafter/Draughtsman score game
; Its using a reactor to count how many commands-calls or lisp-calls you have invoked in that drawing,
; hence increasing your score and position in the ranklist (and your drafting productivity - which is the whole purpose BTW)
; The Rank List is DWG dependent - which means individual rank per project
; Included a final boss - "The Drafter" on the < Extreme > difficulty
; Written by: Grrr
; Credits to: Lee Mac
;-------------------------------------------------------------------------------------------------------
; --- [ Technically speaking (for the lisp heads) ] -------------------------------------------------------------------------------------------------------------
; The routine uses: DCL, Reactors, Dictionaries'n'xRecords, Randomizing subfunctions
; It stores the list statistics data inside the first and only (1 . <dataL>) group code,
; located inside a xrecord in a dictionary with a name "DrafterGame", which is inside the (namedobjdict)
; So that means the Statistics/Rank List is DWG Dependent (which means individual ranklist for the different projects)
; The reactor's events and callback functions are:
; (:VLR-lispWillStart . DG:BeginLsp) (:VLR-lispEnded . DG:EndLsp) (:VLR-lispCancelled . DG:EndLsp) (:VLR-commandWillStart . DG:BeginCmd)
; The callback functions are written as simple as possible (depending on their events) - in order to prevent any slow-down of the working(drafting) process
; *DrafterGame* is a global counter variable, to not slow down the working proccess (for each event to dig into the xDictionary and subst the list.. bla-bla)
; *DGstopCounter* is a global boole variable, This boolean prevents counting command calls inside lisp routine, to prevent cases like this:
;|
(defun C:test ( / )
(repeat 500 (command "_.point" "0,0,0"))
(princ "\nCreated 500 points.")
(princ)
)
|;
; ---------------------------------------------------------------------------------------------------------------------------------------------------------------
(defun C:DraftersGame ( / *error* dcl des dch dcf )
(DG:Statistics nil)
(defun *error* ( msg )
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
); defun *error*
(cond
(
(not
(and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
(mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
'("DraftersGame : dialog "
"{ label = \"Drafter Statistics\";"
"spacer_1;"
": list_box { key = \"LB\"; width = 20; height = 20; tabs = \"18\"; tab_truncate = false; }"
": button { key = \"res\"; label = \"Reset Statistics\"; fixed_width = true; alignment = centered; }"
": button { key = \"info\"; label = \"Info / About\"; fixed_width = true; alignment = centered; }"
"spacer_1; ok_only; : text { key = \"txt\"; alignment = centered; } "
"}"
); list
); mapcar
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
); and
); not
(prompt "\nUnable to write or load the DCL file.")
)
(
(progn
(defun ord ( n ) (cond ((< 10 (rem n 100) 14) "th") ((nth (rem n 10) '(nil "st" "nd" "rd"))) ("th"))) ; LM
(while (not (member dcf '(0 1)))
(cond
( (not (new_dialog "DraftersGame" dch)) (prompt "\nUnable to display the dialog") (setq dcf 0) )
(T
(DG:Statistics nil) ; Looks for the score, or generates a new one | returns the score
(DG:BeginSave nil nil) ; Just call the frekin' reactor's callback function to update the ranklist
(
(lambda ( xRec / L nL nm sc i )
(and
(setq L (GetDataFromMainDic xRec))
(setq nL
(mapcar
(function
(lambda (x / a b )
(setq a (car x)) (setq b (cdr x))
(strcat a "\t" (itoa b))
); lambda
); function
L
); mapcar
); setq nL
(progn
(start_list "LB") (mapcar 'add_list nL) (end_list)
(setq nm (strcat (getvar 'loginname) " "))
(setq sc (cdr (assoc nm L)))
(setq i (1+ (vl-position (cons nm sc) L)))
(set_tile "LB" (itoa (1- i)))
(set_tile "txt"
(if (= 1 i)
"• You won 1st place! •"
(strcat "Your rank is " (itoa i) (ord i))
)
); set_tile "txt"
); progn
); and
); lambda
"DraftersGame"
)
(mapcar 'action_tile '("res" "info") '("(done_dialog 2)" "(DG:Info)"))
(setq dcf (start_dialog))
); T
); cond
(cond
( (= 2 dcf)
(
(lambda ( / tmp )
(and
(setq tmp (DG:DifficultyPrompt))
(progn (IncludeDataIntoMainDic "DraftersGame" nil) (DG:Statistics tmp))
); and
); lambda
)
); (= 2 dcf)
); cond
); while
(/= 1 dcf)
); progn
)
); cond
(*error* nil) (princ)
); defun
(and
(defun DG:BeginLsp ( rtr arg ) ; Increase the counter and turn on the stop flag
(setq *DraftersGame* (1+ (cond (*DraftersGame*)(0))))
(setq *DGstopCounter* t) ; This boolean prevents counting command calls inside lisp routine, to prevent cases like this: (defun C:test nil (repeat 500 (command "_.point" "0,0,0")) (princ "\nCreated 500 points.") (princ) )
(princ)
); defun DG:BeginCmd
(defun DG:BeginCmd ( rtr arg ) ; Check if theres a stop flag, if not then increase the counter
(if (not *DGstopCounter*) (setq *DraftersGame* (1+ (cond (*DraftersGame*)(0)))))
(princ)
); defun DG:BeginCmd
(defun DG:EndLsp ( rtr arg ) ; Remove the counter, the lisp ended.
(setq *DGstopCounter* nil) (princ)
); defun DG:BeginCmd
; (defun DG:EndCmd ( rtr arg ) ; Not sure when to use it
; (princ)
; ); defun DG:BeginCmd
(defun DG:BeginSave ( rtr arg / xRec L itm L )
(cond ; Check if the list exist, count and sort the results, and display them
( (and *DraftersGame* (setq xRec "DraftersGame") (setq L (GetDataFromMainDic xRec)))
(setq itm (assoc (strcat (getvar 'loginname) " ") L))
(setq L
(vl-sort
(subst (cons (car itm) (+ *DraftersGame* (cdr itm))) itm L)
(function (lambda (a b) (apply '> (mapcar 'cdr (list a b)))))
); vl-sort
); setq L
(IncludeDataIntoMainDic xRec L)
(setq *DraftersGame* nil)
)
); cond
(princ)
); defun DG:BeginSave
(progn
(foreach rtr (cdar (vlr-reactors :VLR-Editor-reactor)) (if (= "DraftersGame" (vlr-data rtr)) (vlr-remove rtr)) )
(vlr-Editor-reactor "DraftersGame"
'(
(:VLR-lispWillStart . DG:BeginLsp)
(:VLR-lispEnded . DG:EndLsp)
(:VLR-lispCancelled . DG:EndLsp)
(:VLR-commandWillStart . DG:BeginCmd)
; (:VLR-commandEnded . DG:EndCmd)
; (:VLR-commandCancelled . DG:EndCmd)
; (:VLR-commandFailed . DG:EndCmd)
(:VLR-beginSave . DG:BeginSave)
)
); vlr-Editor-reactor "DraftersGame"
); progn
); and
; (IncludeDataIntoMainDic "DraftersGame" nil) (DG:Statistics "Novice")
; d - difficulty
(defun DG:Statistics ( d / xRec fnbs r tmp ) ; Looks for the score, or generates a new one | returns the score
(setq xRec "DraftersGame")
(setq fnbs "The Drafter") ; Final Boss, yes I wan't one
(or
(setq r (GetDataFromMainDic xRec))
(setq r
(IncludeDataIntoMainDic xRec
(append
(cond
( (or (member d '("Novice" "Easy" "Normal" "Hard" "Extreme")) (setq d "Normal")) ; Default - Normal
(setq tmp
(cdr
(assoc d
'(
("Novice"
10 40
("Billy" "Timmy" "Tonny" "Wendy" "Willy")
)
("Easy"
40 150
("Tom" "Joel" "Alex" "Bobby" "Clyde"
"Dane" "Jeremy" "Kevin" "Lesley" "Phil"
)
)
("Normal"
150 500
("John" "Alan" "Brian" "Mark" "Chad"
"Richard" "Derek" "Jeff" "Tony" "Michael"
"Frank" "Jamie" "Lindsay" "Andrey" "Dimitry"
)
)
("Hard"
500 1000
("Jude Milhon" "Sam Jain" "Mixter" "HD Moore" "Joe Grand" "Christien Rioux"
"John Draper" "Chris Lamprecht" "Aaron Swartz" "Leonard Rose" "Steve Wozniak"
)
)
("Extreme"
1000 1700
("GH0UL" "C0MB0" "QU35710N" "1D0L"
"J1NX" "5H13LD" "L16H7N1N6" "PUCK377"
"A70M" "M1M3" "R1D3R" "L33_M4C"
)
)
); list
); assoc
); cdr
); setq tmp
(setq tmp (apply 'GenerateDrafterStatistics tmp))
(and (= d "Extreme") (setq tmp (cons (cons fnbs (fix (* 1.3 (cdar tmp)))) tmp)) tmp)
tmp
)
); cond
(list (cons (strcat (getvar 'loginname) " ") 0))
); append
); IncludeDataIntoMainDic
); setq r
); or
r
); defun
; mins - minimum score
; maxs - maximum score
; L - List of Names
; (GenerateDrafterStatistics1500 5000 '("John" "Alan" "Brian" "Mark" "Chad" "Richard" "Derek" "Tony" "Willy" "Frank" "Jamie" "Wendy" "Lindsay" "Andrey" "Dimitry"))
(defun GenerateDrafterStatistics ( mins maxs L / )
(vl-sort ; Assoc list of: '(<Name> . <Score>)
(mapcar
(function (lambda (x) (cons x (LM:randrange mins maxs))))
(RandomizeList L)
); mapcar
(function (lambda (a b) (apply '> (mapcar 'cdr (list a b)))))
); vl-sort
); defun GenerateDrafterStatistics
(defun RandomizeList ( L / itm nL )
(if (vl-consp L)
(while L
(setq itm (nth (LM:randrange 0 (1- (length L))) L))
(setq nL (cons itm nL))
(setq L (vl-remove itm L))
); while
); if
nL
); 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))))))
)
; (IncludeDataIntoMainDic "MyXrec" nil)
; (IncludeDataIntoMainDic "MyXrec" '("Custom" 2 "data"))
; xRecName - xrecord name
; dataL - basically any type of data (usually its a list) if nil, then the xrecord will be deleted.
; http://www.theswamp.org/index.php?topic=5003.0
(defun IncludeDataIntoMainDic ( xRecName dataL / maindic xrec )
(cond
( (not (eq 'STR (type xRecName))) (prompt "\nxRecName is not STR type.") )
( (vl-some (function (lambda (x) (wcmatch (strcase xRecName) x))) '("ACAD*" "AEC*" "Ac*")) ; Being paranoid
(prompt "\nInvalid xRecord name.")
)
(t
(setq maindic (namedobjdict))
(if (setq xrec (dictsearch maindic xRecName)) (entdel (cdr (assoc -1 xrec))))
(if dataL (dictadd maindic xRecName (entmakex (append '((0 . "XRECORD") (100 . "AcDbXrecord")) (list (cons 1 (vl-prin1-to-string dataL)))))))
); t
); cond
); defun IncludeDataIntoMainDic
; (GetDataFromMainDic "MyXrec")
; http://www.theswamp.org/index.php?topic=5003.0
(defun GetDataFromMainDic ( xRecName / tmp r )
(and
(setq tmp (dictsearch (namedobjdict) xRecName))
(setq tmp (cdr (assoc 1 tmp)))
(setq r (read tmp))
); and
r
); defun GetDataFromMainDic
(defun DG:DifficultyPrompt ( / *error* dcl des dch dcf L r )
(defun *error* ( msg )
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
); defun *error*
(cond
(
(not
(and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
(mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
(list
"test : dialog "
"{ label = \"Choose Difficulty\"; spacer_1; "
": column"
"{ width = 6; children_fixed_width = false; "
(apply 'strcat
(mapcar
(function
(lambda (x)
(strcat " : button { key = \"" x "\"; label = \"< " x " >\"; alignment = centered; height = 2; }")
)
)
(setq L '("Novice" "Easy" "Normal" "Hard" "Extreme"))
); mapcar
); apply 'strcat
"}"
"spacer_1; cancel_button; spacer_1; "
"}"
); list
); mapcar
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
); and
); not
(prompt "\nUnable to write or load the DCL file.")
)
( (not (new_dialog "test" dch)) (prompt "\nUnable to display the dialog") )
(
(progn
(mode_tile "Normal" 2)
(mapcar
(function
(lambda (x)
(action_tile x "(progn (setq r $key) (done_dialog 1))")
); lambda
); function
L
); mapcar
(/= 1 (setq dcf (start_dialog)))
); progn
)
); cond
(*error* nil) (princ) r
); defun
(defun DG:Info ( / *error* dcl des dch dcf L nm sc i )
(defun ord ( n ) (cond ((< 10 (rem n 100) 14) "th") ((nth (rem n 10) '(nil "st" "nd" "rd"))) ("th"))) ; LM
(
(lambda ( / tmpL )
(and
(setq nm (strcat (getvar 'loginname) " "))
(setq sc (cdr (assoc nm (setq tmpL (GetDataFromMainDic "DraftersGame")))))
(setq i (1+ (vl-position (cons nm sc) tmpL)))
)
)
)
(defun *error* ( msg )
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
); defun *error*
(cond
( (not (and nm sc i)) (prompt "\nDG:Info: no arguments.") )
(
(not
(and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
( ; Sorry about that - copyright stuff
'((b c a)
(mapcar ''((x) (princ (strcat "\n" x) des))
(apply ''((n m o) (append (mapcar 'vl-list->string n) m (mapcar 'vl-list->string (reverse o))))
(mapcar 'eval (read (apply 'strcat (mapcar 'chr '(40 97 32 98 32 99 41)))))
)
)
)
(list
(strcat ": text { value = \"Name: '' " nm " ''\"; alignment = left; }")
(strcat ": text { value = \"Rank: " (itoa i) (ord i) "\"; alignment = left; }")
(strcat ": text { value = \"Score: " (itoa sc) "\"; alignment = left; }")
); list
'((125)
(32 32 115 112 97 99 101 114 95 49 59 32 32 58 32 98 117 116 116 111 110 32 123 32 107 101 121 32 61 32 34 111 107 34 59 32 105 115 95 99 97 110
99 101 108 32 61 32 116 114 117 101 59 32 105 115 95 100 101 102 97 117 108 116 32 61 32 116 114 117 101 59 32 108 97 98 101 108 32 61 32 34 32
32 32 79 75 32 32 32 34 59 32 102 105 120 101 100 95 119 105 100 116 104 32 61 32 116 114 117 101 59 32 104 101 105 103 104 116 32 61 32 50 59 32
97 108 105 103 110 109 101 110 116 32 61 32 99 101 110 116 101 114 101 100 59 32 125 32 115 112 97 99 101 114 95 49 59 32
)
(32 32 125)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 67 114 101 100 105 116 115 32 116 111 58 32
76 101 101 32 77 97 99 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 99 101 110 116 101 114 101 100 59 125
)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 87 114 105 116 116 101 110 32 98 121
58 32 71 114 114 114 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 99 101 110 116 101 114 101 100 59 125
)
(32 32 123) (32 32 58 32 99 111 108 117 109 110) (32 32 115 112 97 99 101 114 95 49 59) (32 32 125) (32 32 32 32 115 112 97 99 101 114 59)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 32 32 32 32 111 114 32 99 97 108 108 32 116 104 105 115
32 100 105 97 108 111 103 32 97 103 97 105 110 46 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 108 101 102 116 59 125
)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 32 32 32 32 119 104 101 110 32 121 111 117 32 115 97
118 101 32 116 104 101 32 100 114 97 119 105 110 103 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 108 101 102 116 59 125
)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 149 32 89 111 117 114 32 115 99 111 114 101 32
119 105 108 108 32 117 112 100 97 116 101 58 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 108 101 102 116 59 125
)
(32 32 32 32 115 112 97 99 101 114 59)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 32 32 32 32 109 111 114 101 32 116 104 97 110 32 97 110 121 111 110 101
32 101 108 115 101 32 105 110 32 116 104 101 32 108 105 115 116 46 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 108 101 102 116 59 125
)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 32 32 32 32 121 111 117 32 104 97 118 101 32 116 111 32
117 115 101 32 99 111 109 109 97 110 100 32 99 97 108 108 115 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 108 101 102 116 59 125
)
(32 32 32 32 58 32 116 101 120 116 32 123 32 118 97 108 117 101 32 61 32 34 149 32 84 111 32 103 101 116 32 104 105103 104 101
114 32 105 110 32 116 104 101 32 108 105 115 116 58 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 108 101 102 116 59 125
)
(32 32 123 32 108 97 98 101 108 32 61 32 34 71 117 105 100 101 34 59 32) (32 32 58 32 98 111 120 101 100 95 99 111 108 117 109 110) (32 32 115 112 97 99 101 114 95 49 59)
(32 32 125) (32 32 115 112 97 99 101 114 59)
)
'( (68 71 95 73 110 102 111 32 58 32 100 105 97 108 111 103 32)
(123 32 108 97 98 101 108 32 61 32 34 68 114 97 102 116 101 114 115 32 71 97 109101 32 73 110
102 111 34 59 32 115 112 97 99 101 114 95 49 59 32 119 105 100 116 104 32 61 32 51 54 59 32
)
(32 32 58 32 98 111 120 101 100 95 99 111 108 117 109 110) (32 32 123 32 108 97 98 101 108 32 61 32 34 89 111 117 114 32 115 116 97 116 115 34 59 32)
(32 32 115 112 97 99 101 114 59)
)
)
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
); and
); not
(prompt "\nUnable to write or load the DCL file.")
)
( (not (new_dialog "DG_Info" dch)) (prompt "\nUnable to display the dialog") )
( (/= 1 (setq dcf (start_dialog))) )
); cond
(*error* nil) (princ)
); defun
https://preview.ibb.co/fKzBPG/Drafters_Game.jpg 干得好Grrr（但我想我会切换命令和lisp反应器来提高我的分数）thanx！
gr.Rlx 谢谢Rlx，
最简单的作弊方法是修改全局计数器变量，但这会破坏游戏的目的。 现在我想起来了，我工作的座右铭是“更聪明地工作，而不是更努力”，所以你们的计划完全违背了公司的政策，糟糕的Grrr，我的老板可能想和你们聊一聊！
我也这么认为，但在我的国家，每个人都被迫努力工作，而不是更聪明。
这就是为什么聪明的技术人才会移民到像你们这样的国家，在那里一切都做得很好。
即使是逃犯也害怕留在这里。
就我而言，我喜欢在这里与穴居人绘图员竞争。
很遗憾听到你们的国家不能很好地留住人才，当然当他们和你们一样有天赋的时候！你的动作是最好的！ 出色的工作Grrr！-做得好。
我看到你的AutoLISP编程技能已经快速提高，现在你定期参加各种CAD编程论坛-我希望我仍然有时间继续访问社区，并像以前一样频繁地为社区做出贡献。。。这几天工作很忙！
PS：“PUCK377”“L33\u M4C”我喜欢 很酷 双柱
不，不要感到抱歉Rlx-每个国家的功能不同，取决于其政治，因此其公民的生活水平和教育是不同的。
谢谢你的夸奖，但我只是不断地向别人学习——他们的惯例/建议/评论。
每个人都是我的榜样，我从不低估任何人，所以这是我提高的方式。特别是当创新的东西摆在桌面上，或者它涵盖了我的兴趣。
看，我想象一个像李这样的人在论坛上浏览最新信息，
然后看到新发布的400行代码，快速滚动（在喝他的茶之前）并想着“是的，我知道这个技术，我也知道那个”。
如果有什么新东西介绍给他，我想他会把它保存在自己的档案中，使用几次，这样它就会成为他“已知的技术”。
每天都有这样的传统，难怪他是如何成为今天的他。
谢谢李，
如果没有你多年来在论坛上提供的大量帮助和例子，这个想法就不会这么快实现！
实际上，我几乎所有的lisp工作都是您帮助的结果，这是因为每次我询问/谈论某事时，您都会不断做出贡献。
所以，当我发布一些这样的例行公事时，我真的试着通过敬礼你的名字来抵制，不去打扰别人。
我想你不知道世界上有多少人欠你时间。。所以我只是希望这些想法（常规）能帮助你。
对你来说，除了一个想法之外，别无选择（因为似乎唯一的限制必须是你的想象力）。
我一直把你们想象成黑客！
谢谢你，罗恩！
页:
[1]
2