HappyBirthday.lsp ==>Fun vs. prank

[Lee Mac]

is there a way to not pank my draftsman the whole day?
... 3 or 4 times would be enough ...

Something like this perhaps:

(   (lambda ( lst / age itm ord ret tmp )
        (defun ord ( n ) (cond ((< 10 (rem n 100) 14) "th") ((nth (rem n 10) '(nil "st" "nd" "rd"))) ("th")))
        (cond
            (   (null (setq itm (assoc (strcase (getvar 'loginname)) lst)))
                (princ "\nSorry, user not listed!")
            )
            (   (and (zerop (rem (setq age (- (fix (getvar 'cdate)) (caddr itm))) 10000))
                     (or (null (setq tmp (getenv "CurrentAge")))
                         (/= age (atoi tmp))
                     )
                )
                (setenv "CurrentAge" (itoa age))
                (setq age (/ age 10000)
                      ret (- (cadddr itm) age)
                )
                (alert
                    (strcat 
                        "Hello " (cadr itm) "!"
                        "\n\nHerzlichen Glückwunsch zum " (itoa age) ". Geburtstag !!!"
                        "\n\nCongratulations on your " (itoa age) (ord age) " Birthday !!!"
                        "\n\n\n\nVon jetzt an, sind es nur noch " (itoa ret) " Jahre bis zur Rente \n... Also hau rein ... :-)"
                        "\n\nFrom now on, there are only " (itoa ret) " years left to retirement \n... so get in there ... :-)"
                        "\n\n\nKeyuser Michael"
                    )
                )
            )
        )
        (princ)
    )
   '(
        ("MH019" "Michael" 19991003 67)
        ("MH019" "Michael" 20180109 67)
        ("MH019" "Michael" 20180110 67)
    )
)

[Bluebird1973]

Great !!!

... but I would like to prank a little bit...
is it possible to add a counter which I could set to show up 3-4 times?

[Grrr]

This made me wonder, why not write some generic function that uses one of the arguments:
'(day week month year)

; (RunOnceA 'day (lambda nil (alert "Hello world!")))
(defun RunOnceA ( sym func / env dateL tmp new old aL )
  
  (defun SubstrByN ( n str ) (if (and (eq 'INT (type n)) (> n 0) (/= "" str)) (cons (substr str 1 n) (SubstrByN n (substr str (1+ n))))) )
  
  (setq env "RunOnceA")
  (setq dateL
    (lambda nil
      (mapcar 'cons '(year month day)
        (apply '(lambda (a b c d) (list (strcat a b) c d))
          (SubstrByN 2 (vl-prin1-to-string (fix (getvar 'cdate))))
        )
      )
    )
  )
  (and ; first time using 'RunOnceA' function
    (or (= (setq tmp (getenv env)) "") (not tmp) )
    (progn
      (setenv env (vl-prin1-to-string (dateL)))
      (func)
    ); progn
  ); and
  
  (if (member sym '(day month year)) ; check if valid symbol is provided, to avoid redundant prompts
    (if
      (not 
        (equal
          (setq new (assoc sym (dateL)))
          (setq old (assoc sym (setq aL (read (getenv env)))))
        )
      )
      (progn (setenv env (vl-prin1-to-string (subst new old aL))) (func) ) ; first store the current date, incase (func) crashes
      (prompt (strcat "\nRunOnceA: will evaluate the next " (strcase (vl-prin1-to-string sym) t) "."))
    ); if
    (prompt "\nRunOnceA: invalid symbol provided, use [day/month/year].")
  ); if
  
); defun RunOnceA

[rlx]

; (RunOnceA 'day (lambda nil (alert "Hello world!")))
(defun RunOnceA ( sym func / env dateL tmp new old aL )
  
  (defun SubstrByN ( n str ) (if (and (eq 'INT (type n)) (> n 0) (/= "" str)) (cons (substr str 1 n) (SubstrByN n (substr str (1+ n))))) )
  
  (setq env "RunOnceA")
  (setq dateL
    (lambda nil
      (mapcar 'cons '(year month day)
        (apply '(lambda (a b c d) (list (strcat a b) c d))
          (SubstrByN 2 (vl-prin1-to-string (fix (getvar 'cdate))))
        )
      )
    )
  )
  (and ; first time using 'RunOnceA' function
    (or (= (setq tmp (getenv env)) "") (not tmp) )
    (progn
      (setenv env (vl-prin1-to-string (dateL)))
      (func)
    ); progn
  ); and
  
  (if (member sym '(day month year)) ; check if valid symbol is provided, to avoid redundant prompts
    (if
      (not 
        (equal
          (setq new (assoc sym (dateL)))
          (setq old (assoc sym (setq aL (read (getenv env)))))
        )
      )
      (progn (setenv env (vl-prin1-to-string (subst new old aL))) (func) ) ; first store the current date, incase (func) crashes
      (prompt (strcat "\nRunOnceA: will evaluate the next " (strcase (vl-prin1-to-string sym) t) "."))
    ); if
    (prompt "\nRunOnceA: invalid symbol provided, use [day/month/year].")
  ); if
  
); defun RunOnceA

Nicely coded

Gr. Rlx

[Grrr]

Nicely coded

Gr. Rlx

Thanks!
I hope it works as supposed - didn't found any problems in my initial testing.

[Lee Mac]

Great !!!

... but I would like to prank a little bit...
is it possible to add a counter which I could set to show up 3-4 times?

The following will 'prank' the user between 1 and 5 times if they 'roll a 3' when opening a drawing :

;; 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))))))
)

(   (lambda ( lst / age itm ord ret tmp )
        (defun ord ( n ) (cond ((< 10 (rem n 100) 14) "th") ((nth (rem n 10) '(nil "st" "nd" "rd"))) ("th")))
        (cond
            (   (null (setq itm (assoc (strcase (getvar 'loginname)) lst)))
                (princ "\nSorry, user not listed!")
            )
            (   (and (zerop (rem (setq age (- (fix (getvar 'cdate)) (caddr itm))) 10000))
                     (= 3 (LM:randrange 1 6)) ;; Adding some randomness to when the message is displayed
                     (cond
                         (   (or (null (setq tmp (getenv "CurrentAge"))) (< (atoi tmp) age))
                             (setenv "CurrentAge" (itoa (+ age (LM:randrange 1 5))))
                         )
                         (   (< age (atoi tmp))
                             (setenv "CurrentAge" (itoa (1- (atoi tmp))))
                         )
                     )
                )
                (setq age (/ age 10000)
                      ret (- (cadddr itm) age)
                )
                (alert
                    (strcat 
                        "Hello " (cadr itm) "!"
                        "\n\nHerzlichen Glückwunsch zum " (itoa age) ". Geburtstag !!!"
                        "\n\nCongratulations on your " (itoa age) (ord age) " Birthday !!!"
                        "\n\n\n\nVon jetzt an, sind es nur noch " (itoa ret) " Jahre bis zur Rente \n... Also hau rein ... :-)"
                        "\n\nFrom now on, there are only " (itoa ret) " years left to retirement \n... so get in there ... :-)"
                        "\n\n\nKeyuser Michael"
                    )
                )
            )
        )
        (princ)
    )
   '(
        ("MH019" "Michael" 19991003 67)
        ("MH019" "Michael" 20180109 67)
        ("MH019" "Michael" 20180110 67)
    )
)

(princ)

[rlx]

Well thank you Lee

[Grrr]

Just imagine Lee's code triggering some Sapi voices randomly!

[rlx]

Just imagine Lee's code triggering some Sapi voices randomly!

Most people here have muted their pc but the colleague right in front of me hasn't ... he would make a good candidate. In fact , I have 'pranked' him in the past. He likes to kill rabbits in his spare time so one day I arranged for a slide to appear with each drawing he opened with a armed rabbit showing

[Grrr]

Most people here have muted their pc but the colleague right in front of me hasn't ... he would make a good candidate. In fact , I have 'pranked' him in the past. He likes to kill rabbits in his spare time so one day I arranged for a slide to appear with each drawing he opened with a armed rabbit showing

That sounds like a good practice,
I was imaginig more like a windows XP loading sound upon running autocad (annoying nostalgia).