[讨论]：Lisp中关键字的“一触即发”

ll_j

我也贴一个古旧的程序，这是94年的版本（现在不需要了），是在图形中调入文本文件的，当时是DOS界面，使用了切换文本屏幕，达到自动刷新屏幕的功能（现在的Windows文本屏幕没有办法刷新了），由于在文本屏grread函数只支持键盘，所以程序中没有使用参数。
[php](defun erro1(s)
  (if (or (= s "Function cancelled") (= s "console break"))
    (setvar "filedia" filda)
  )
  (setq *error* old_error)
  (princ)
)
(defun erro2(s)
  (if (or (= s "Function cancelled") (= s "console break"))
    (progn
      (setvar "regenmode" 0)
      (command "style" texsl texsl 0 0.8 0 "" "" "")
      (setvar "regenmode" 1)
      (if (/= ro 0) (command "ucs" ""))
      (setvar "filedia" filda)
    )
  )
  (setq *error* old_error)
  (princ)
)

(defun pr(nb n$ / b_)
  (setq b_ nb
        nb (getdist n$))
  (if (or (= nb "") (= nb nil)) (setq bb b_) (setq bb nb))
)
(defun c:hzt() (c:hz))
(defun c:hz(/ sblip texsl texsi fname filda fp styl styl2
            pt ht bt lsp csp ro ob base len ln newx newy i1 i2
            a_ y code wd ns styl1 bb sna1 sna2)
  (setq sblip (getvar "blipmode")
        texsi (getvar "textsize")
        texsl (getvar "textstyle")
        filda (getvar "filedia")
        fname nil)
  (setq old_error *error* *error* erro1)
  (if (= texsl "STANDARD") (setq texsl "romand"))
  (setq styl (getstring "\nSelect Chinese font name :<tjhzf> "))
  (if (or (= styl nil) (= styl "")) (setq styl "tjhzf"))
  (setq styl1(getstring "\nSelect English font name :<romand> "))
  (if (or (= styl1 nil) (= styl1 "")) (setq styl1 "romand"))
  (setq styl2(strcat styl1 "," styl)
        ht 0.5 bt 0.88 lsp 0.75 csp 0.005 ob 0 ro 0 a_ 0)
  (setq sna1 (strcat texsl ".shx")
        sna2 (findfile sna1))
  (if (= sna2 nil) (setq texsl styl1))
  (while (/= a_ nil)
    (textpage)
    (princ "\n\n\n")
    (princ "\n\tChinese font name: <")(princ styl)(princ ">")
    (princ "\n\tEnglish font name: <")(princ styl1)(princ ">")
    (princ "\n\n\n\tChinese text set as below :")
    (princ "\n\t  1 : Text height :       ")(princ ht)
    (princ "\n\t  2 : Width falor :       ")(princ bt)
    (princ "\n\t  3 : Line space :        ")(princ lsp)
    (princ "\n\t  4 : Character space :   ")(princ csp)
    (princ "\n\t  5 : Obliquing angle :   ")(princ ob)
    (princ "\n\t  6 : Rotation angle :    ")(princ ro)
    (princ "\n\t  0 or [Enter] means done !")
    (princ "\n\n\n\tPlease select an item to modify : ")
    (setq a_ (cadr (grread)))
    (if (= (type a_) 'int)
      (progn
        (setq a_ (chr a_))
        (if (= a_ "1") (progn (pr ht "\n\tText height :") (setq ht bb)))
        (if (= a_ "2") (progn (pr bt "\n\tWidth falor :") (setq bt bb)))
        (if (= a_ "3") (progn (pr lsp "\n\tLine space :") (setq lsp bb)))
        (if (= a_ "4") (progn (pr csp "\n\tCharacter space :") (setq csp bb)))
        (if (= a_ "5") (progn (pr ob "\n\tObliquing angle : ") (setq ob bb)))
        (if (= a_ "6") (progn (pr ro "\n\tRotation angle :") (setq ro bb)))
        (if (or (= a_ "0") (= a_ "\r") (= a_ nil)) (setq a_ nil))
      )
    )
  )
  (while (= nil fname)
    (if (= (ver) "AutoLISP Release 12.0 (en)")
      (progn
        (textpage)
        (setq fname (getfiled "Select a text file:" "" "*" 6))
        (if (/= fname nil) (setq fp (open fname "r")))
      )
      (progn
        (princ "\n")
        (princ "\n")
        (setq fname (findfile (getstring "\n\tPlease input file name: ")))
        (if (/= fname nil)
          (setq fp (open fname "r"))
          (princ "\n\tThe file was not foud.")
        )
      )
    )
  )
  (graphscr)
  (setq pt (getpoint "\nPlease enter a point:"))
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setvar "filedia" 0)
  (setq *error* erro2)
  (setvar "regenmode" 0)
  (command "style" styl styl2 0 bt ob "" "")
  (if (/= ro 0) (command "ucs" "z" ro))
  (command "regenmode" 1)
  (setq base (car pt)
        newy (+ (- (cadr pt) ht) lsp)
        pt (list base newy)
        ln (read-line fp))
  (while (/= ln nil)
    (setq newy (- (cadr pt) lsp)
          pt (list base newy)
          len (strlen ln))
    (while (> len 0)
      (setq i1 (ascii ln)
            ln (substr ln 2)
            len (strlen ln))
      (if (> i1 127)
        (progn
          (setq i2 (ascii ln)
                ln (substr ln 2)
                len (strlen ln))
          (if (or (and (> i1 159) (< i1 166)) (> i1 175))
            (progn
              (setq code(strcat (chr i1) (chr i2)))
              (command "text" pt ht 0 code)
            )
          )
          (setq newx (+ (car pt) (* bt ht) csp)
                y (cadr pt)
                pt (list newx y))
        )
        (progn
          (if (= i1 9)
            (progn
              (setq wd (- (+ (car pt) (* ht 0.2)) base)
                    ns (+ (fix (/ wd (* (+ (* ht bt) csp) 4))) 1)
                    newx (+ (* ns (+ (* ht bt) csp) 4) base)
                    y (cadr pt)
                    pt (list newx y))
            )
          )
          (if (> i1 31)
            (if (or (= i1 109) (= i1 64))
              (progn
                (command "text" pt (* ht 0.7) 0 (chr i1))
                (setq newx (+ (car pt) (+ (* ht bt 0.9) csp))
                      y (cadr pt)
                      pt (list newx y))
              )
              (progn
                (command "text" pt (* ht 0.7) 0 (chr i1))
                (setq newx (+ (car pt) (+ (* ht bt 0.55) csp))
                      y (cadr pt)
                      pt (list newx y))
              )
            )
          )
        )
      )
    )
    (setq ln (read-line fp))
  )
  (close fp)
  (setvar "regenmode" 0)
  (if (/= ro 0) (command "ucs" ""))
  (setvar "blipmode" sblip)
  (setvar "textsize" texsi)
  (command "style" texsl "" 0.0 0.8 0.0 "" "" "")
  (command "filedia" filda)
  (command "regenmode" 1)
  (setq *error* old_error)
  (princ)
)[/php]

xgwl

呵呵！ 今天突然冒出一个想法， 解决了我自己提出的“用组合键一确即发”的问题！ 以楼主第一个程序为例， 小改动了一下！

2. 
   
3.   [FONT=courier new]
   
4. ....
   
5. 
   
6.   (princ "\n[[ctrl+A] - 绘制直线 / C - 绘制园 /E - exit]: ")
   
7.     )
   
8.     (setq mod (grread nil 10 0))
   
9.     (cond
   
10.       ((and (= (car mod) 11)
    
11.             (= (strcase (chr (cadr mod))) "0")
    
12.        )
    
13. 
    
14. ....
    
15.   [/FONT]
    

<br />   [FONT=courier new]<br /> ....<br /> <br />   (princ "\n[[ctrl+A] - 绘制直线 / C - 绘制园 /E - exit]: ")<br />     )<br />     (setq mod (grread nil 10 0))<br />     (cond<br />       ((and (= (car mod) 11)<br />             (= (strcase (chr (cadr mod))) "0")<br />        )<br /> <br /> ....<br />   [/FONT]<br />

brainstorm

grread在实现热键功能时，如果直接点击鼠标右键失灵

dandee

我也来说两句，
1，选择关键字选项，现在可以用更好的办法，用新版的opendcl,可以做成按钮的菜单形式，（可以去掉标题栏了），并且按钮菜单直接在鼠标位置的地方跳出，这样选项更快捷。
2， grread现在可以做的功能更加强大，已经做到捕捉方式的显示和捕捉，至于grread 这个函数
只要创意，程序j就会变得很完美，高效

123456abc

受教了    呵呵

netbee

除非做一些即时绘制显现的时间，不然一确即发会让用惯了空格的人无法适应，而且程序不可避免的要用一些GETXXXX函数，而这些函数却是需要按空格（回车）的，这样操作对快速绘图有很大影响。
正准备向grread中加入必须回车才能返回响应的功能。

雨箭风刀

做一个表收集gr返回值即可

h0404

grread,困扰我好久了，我想它可能跟鼠标有关，想研究它，呵呵，现在可以好好看看这个帖子了。

ysq101

好例子。。新手又学到了。。谢谢版主