一个时钟程序

Lisphk · 发表于 2018-9-13 13:26:51

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

一个时钟程序

(defun c:clo (/ A1 GR I S)
;; ElpanovEvgeniy, Russia, Moscow, 2006
;; Clock that show time in the screen
(setq a1 (/ pi 30))
(while (= (car (setq gr (grread nil 5 1))) 5)
(setq s (/ (getvar "viewsize") 8.)
gr (trans (cadr gr) 1 3)
i 0
) ;_ setq
(redraw)
(grvecs ;SS
'(2 (-0.01 0.) (1. 0.))
((lambda (a)
((lambda (c s x y sc)
(list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.))
) ;_ lambda
(* (cos a) s)
(* (sin a) s)
(car gr)
(cadr gr)
s
)
) ;_ lambda
(- (/ pi 2.) (* (/ pi 30.) (atof (menucmd "M=$(edtime,$(getvar,date),SS.MSEC)"))))
)
) ;_ grvecs
(grvecs ;MM
'(3 (-0.01 0.) (0.8 0.)
3 (-0.01 -0.01) (0.6 -0.01)
3 (-0.01 0.01) (0.6 0.01)
3 (-0.01 -0.02) (0.4 -0.02)
3 (-0.01 0.02) (0.4 0.02)
3 (0.4 -0.02) (0.8 0.)
3 (0.4 0.02) (0.8 0.)
)
((lambda (a)
((lambda (c s x y sc)
(list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.))
) ;_ lambda
(* (cos a) s)
(* (sin a) s)
(car gr)
(cadr gr)
s
)
) ;_ lambda
(- (/ pi 2.) (* (/ pi 30.) (atoi (menucmd "M=$(edtime,$(getvar,date),MM)"))))
)
) ;_ grvecs
(grvecs ;H
'(1 (-0.01 0.) (0.5 0.)
1 (-0.01 -0.01) (0.4 -0.01)
1 (-0.01 0.01) (0.4 0.01)
1 (-0.01 -0.02) (0.3 -0.02)
1 (-0.01 0.02) (0.3 0.02)
1 (-0.01 -0.03) (0.2 -0.03)
1 (-0.01 0.03) (0.2 0.03)
1 (0.2 -0.03) (0.5 0.)
1 (0.2 0.03) (0.5 0.)
)
((lambda (a)
((lambda (c s x y sc)
(list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.))
) ;_ lambda
(* (cos a) s)
(* (sin a) s)
(car gr)
(cadr gr)
s
)
) ;_ lambda
(- (/ pi 2.)
(* (/ pi 6.)
(+ (atoi (menucmd "M=$(edtime,$(getvar,date),H)"))
(/ (atoi (menucmd "M=$(edtime,$(getvar,date),MM)")) 60.)
) ;_ +
) ;_ *
) ;_ -
)
) ;_ grvecs
(repeat 4
(grvecs
'(6 (0.8 0.) (0.82 0.02)
6 (0.82 0.02) (1. 0.02)
6 (1. 0.02) (1. -0.02)
6 (1. -0.02) (0.82 -0.02)
6 (0.82 -0.02) (0.8 0.)
)
((lambda (c s x y sc)
(list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.))
) ;_ lambda
(* (cos (* a1 i)) s)
(* (sin (* a1 i)) s)
(car gr)
(cadr gr)
s
)
) ;_ grvecs
(repeat 3
(grvecs
'(5 (1. 0.01) (0.92 0.01) 5 (1. -0.01) (0.92 -0.01)5 (0.92 0.01)(0.89 0.) 5 (0.92 -0.01)(0.89 0.))
((lambda (c s x y sc)
(list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.))
) ;_ lambda
(* (cos (* a1 i)) s)
(* (sin (* a1 i)) s)
(car gr)
(cadr gr)
s
)
) ;_ grvecs
(repeat 5
(grvecs
'(3 (-0.25 1.2) (0 1.3) 3 (0 1.3) (0.25 1.2) 3 (0.25 1.2) (0 1.1) 3 (0 1.1) (-0.25 1.2))
((lambda (c s x y sc)
(list (list c (- s) 0. (+ s s (* s 0.5) x))
(list s c 0. y)
(list 0. 0. sc 0.)
'(0. 0. 0. 1.)
) ;_ list
) ;_ lambda
(* (cos (* a1 i 1)) s)
(* (sin (* a1 i 1)) s)
(car gr)
(cadr gr)
s
)
) ;_ grvecs
(grvecs
'(5 (0.9 0) (1 0)); 5 (1.05 -0.9) (1.05 0.9)
((lambda (c s x y sc)
(list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.))
) ;_ lambda
(* (cos (* a1 i)) s)
(* (sin (* a1 i)) s)
(car gr)
(cadr gr)
s
)
) ;_ grvecs
(setq i (1+ i))
) ;_ repeat
) ;_ repeat
) ;_ repeat
) ;_ while
(redraw)
)

(defun c:clo (/ A1 GR I S) 
  ;;  ElpanovEvgeniy, Russia, Moscow, 2006 
  ;;  Clock that show time in the screen 
  (setq a1 (/ pi 30)) 
  (while (= (car (setq gr (grread nil 5 1))) 5) 
    (setq s  (/ (getvar "viewsize") 8.) 
          gr (trans (cadr gr) 1 3) 
          i  0 
    ) ;_  setq 
    (redraw) 
    (grvecs ;SS 
      '(2 (-0.01 0.) (1. 0.)) 
      ((lambda (a) 
         ((lambda (c s x y sc) 
            (list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.)) 
          ) ;_  lambda 
           (* (cos a) s) 
           (* (sin a) s) 
           (car gr) 
           (cadr gr) 
           s 
         ) 
       ) ;_  lambda 
        (- (/ pi 2.) (* (/ pi 30.) (atof (menucmd "M=$(edtime,$(getvar,date),SS.MSEC)")))) 
      ) 
    ) ;_  grvecs 
    (grvecs ;MM 
      '(3 (-0.01 0.)    (0.8 0.) 
        3 (-0.01 -0.01) (0.6 -0.01) 
        3 (-0.01 0.01)  (0.6 0.01) 
        3 (-0.01 -0.02) (0.4 -0.02) 
        3 (-0.01 0.02)  (0.4 0.02) 
        3 (0.4 -0.02)   (0.8 0.) 
        3 (0.4 0.02)    (0.8 0.) 
       ) 
      ((lambda (a) 
         ((lambda (c s x y sc) 
            (list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.)) 
          ) ;_  lambda 
           (* (cos a) s) 
           (* (sin a) s) 
           (car gr) 
           (cadr gr) 
           s 
         ) 
       ) ;_  lambda 
        (- (/ pi 2.) (* (/ pi 30.) (atoi (menucmd "M=$(edtime,$(getvar,date),MM)")))) 
      ) 
    ) ;_  grvecs 
    (grvecs ;H 
      '(1 (-0.01 0.)    (0.5 0.) 
        1 (-0.01 -0.01) (0.4 -0.01) 
        1 (-0.01 0.01)  (0.4 0.01) 
        1 (-0.01 -0.02) (0.3 -0.02) 
        1 (-0.01 0.02)  (0.3 0.02) 
        1 (-0.01 -0.03) (0.2 -0.03) 
        1 (-0.01 0.03)  (0.2 0.03) 
        1 (0.2 -0.03)   (0.5 0.) 
        1 (0.2 0.03)    (0.5 0.) 
       ) 
      ((lambda (a) 
         ((lambda (c s x y sc) 
            (list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.)) 
          ) ;_  lambda 
           (* (cos a) s) 
           (* (sin a) s) 
           (car gr) 
           (cadr gr) 
           s 
         ) 
       ) ;_  lambda 
        (- (/ pi 2.) 
           (* (/ pi 6.) 
              (+ (atoi (menucmd "M=$(edtime,$(getvar,date),H)")) 
                 (/ (atoi (menucmd "M=$(edtime,$(getvar,date),MM)")) 60.) 
              ) ;_  + 
           ) ;_  * 
        ) ;_  - 
      ) 
    ) ;_  grvecs 
    (repeat 4 
      (grvecs 
        '(6 (0.8 0.)     (0.82 0.02) 
          6 (0.82 0.02)  (1. 0.02) 
          6 (1. 0.02)    (1. -0.02) 
          6 (1. -0.02)   (0.82 -0.02) 
          6 (0.82 -0.02) (0.8 0.) 
         ) 
        ((lambda (c s x y sc) 
           (list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.)) 
         ) ;_  lambda 
          (* (cos (* a1 i)) s) 
          (* (sin (* a1 i)) s) 
          (car gr) 
          (cadr gr) 
          s 
        ) 
      ) ;_  grvecs 
      (repeat 3 
        (grvecs 
          '(5 (1. 0.01) (0.92 0.01) 5 (1. -0.01) (0.92 -0.01)5 (0.92 0.01)(0.89 0.) 5 (0.92 -0.01)(0.89 0.)) 
          ((lambda (c s x y sc) 
             (list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.)) 
           ) ;_  lambda 
            (* (cos (* a1 i)) s) 
            (* (sin (* a1 i)) s) 
            (car gr) 
            (cadr gr) 
            s 
          ) 
        ) ;_  grvecs 
        (repeat 5 
          (grvecs 
            '(3 (-0.25 1.2) (0 1.3) 3 (0 1.3) (0.25 1.2) 3 (0.25 1.2) (0 1.1) 3 (0 1.1) (-0.25 1.2)) 
            ((lambda (c s x y sc) 
               (list (list c (- s) 0. (+ s s (* s 0.5) x)) 
                     (list s c 0. y) 
                     (list 0. 0. sc 0.) 
                     '(0. 0. 0. 1.) 
               ) ;_  list 
             ) ;_  lambda 
              (* (cos (* a1 i 1)) s) 
              (* (sin (* a1 i 1)) s) 
              (car gr) 
              (cadr gr) 
              s 
            ) 
          ) ;_  grvecs 
          (grvecs 
            '(5 (0.9 0) (1 0)); 5 (1.05 -0.9) (1.05 0.9) 
            ((lambda (c s x y sc) 
               (list (list c (- s) 0. x) (list s c 0. y) (list 0. 0. sc 0.) '(0. 0. 0. 1.)) 
             ) ;_  lambda 
              (* (cos (* a1 i)) s) 
              (* (sin (* a1 i)) s) 
              (car gr) 
              (cadr gr) 
              s 
            ) 
          ) ;_  grvecs 
          (setq i (1+ i)) 
        ) ;_  repeat 
      ) ;_  repeat 
    ) ;_  repeat 
  ) ;_  while 
  (redraw) 
)

tzfcn · 发表于 2018-9-13 14:52:56

不错、一个好玩的东西！

巴拉巴拉小魔仙 · 发表于 2018-9-13 16:53:15

你好，我想请问下，代码如何复制下来。我复制到visual lisp上，空格都变问号了

yoyoho · 发表于 2018-9-13 17:08:08

感谢分享程序!!!!!

=^_^= · 发表于 2018-9-13 17:57:42

还真很有意思

ynhh · 发表于 2018-9-14 08:45:08

鼠标不动秒针也不动
点左键后图形消失

tiankong2016 · 发表于 2018-9-14 09:14:46

感谢分享程序!!

evayleung · 发表于 2018-9-15 07:28:21

lisp都能雕出花来了

sicky111 · 发表于 2018-9-15 12:58:11

不错不错，谢谢分享。

账号		自动登录	找回密码
密码			立即注册