[编程交流] 绘图者游戏

; --- [The Drafter's Game] -----------------------------------------------------------------------------
; 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) " [You]"))
                     (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) " [You]") 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) " [You]") 0))
       ); append
     ); IncludeDataIntoMainDic
   ); setq r
 ); or
 r
); defun
; mins - minimum score
; maxs - maximum score
; L - List of Names
; (GenerateDrafterStatistics  1500 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) " [You]"))
       (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 105  103 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 109  101 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 

                               
登录/注册后可看大图