跳转到内容

newLISP 简介/更多示例

来自维基教科书,开放世界中的开放书籍

更多示例

[编辑 | 编辑源代码]

本节包含一些 newLISP 实践中的简单示例。您可以在网上和标准 newLISP 发行版中找到大量优秀的 newLISP 代码。

按自己的方式

[编辑 | 编辑源代码]

您可能会发现您不喜欢某些 newLISP 函数的名称。您可以使用 constantglobal 将另一个符号分配给函数

(constant (global 'set!) setf)

您现在可以使用 set! 而不是 setf。这样做不会造成速度损失。

还可以定义您自己的内置函数替代方案。例如,前面我们定义了一个上下文和一个默认函数,它们的工作方式与 println 相同,但它们会记录输出的字符数量。要评估此代码而不是内置代码,请执行以下操作。

首先,定义函数

(define (Output:Output)
 (if Output:counter
   (inc Output:counter (length (string (args))))
   (set 'Output:counter 0))
 (map print (args))
 (print "\n"))

通过为 println 定义别名来保留原始 newLISP 版本的 println

(constant (global 'newLISP-println) println)

println 符号分配给您的 Output 函数

(constant (global 'println) Output)

现在您可以像往常一样使用 println

(for (i 1 10)
 (println (inc i)))
2
3
4
5
6
7
8
9
10
11
(map println '(1 2 3 4 5))
1
2
3
4
5

它似乎与原始函数的工作方式相同。但现在您还可以利用您定义的替代 println 的附加功能

Output:counter
;-> 36 
; or
println:counter
;-> 36

如果您一直在仔细计数,计数器一直在计算传递给 Output 函数的参数长度。当然,这些参数包括括号……

使用 SQLite 数据库

[编辑 | 编辑源代码]

有时,使用现有软件比自己编写所有例程更容易,即使从头开始设计可能会很有趣。例如,您可以通过使用现有的数据库引擎(如 SQLite)而不是构建自定义数据结构和数据库访问函数来节省大量时间和精力。以下是如何在 newLISP 中使用 SQLite 数据库引擎。

假设您有一组想要分析的数据。例如,我发现了一个关于元素周期表中元素的信息列表,以简单的空格分隔表的形式存储

(set 'elements
  [text]1 1.0079 Hydrogen H -259 -253 0.09 0.14 1776 1 13.5984
  2 4.0026 Helium He -272 -269 0 0 1895 18 24.5874
  3 6.941 Lithium Li 180 1347 0.53 0 1817 1 5.3917
  ...
  108 277 Hassium Hs 0 0 0 0 1984 8 0
  109 268 Meitnerium Mt 0 0 0 0 1982 9 0[/text])

(您可以在 GitHub 上的 此文件 中找到该列表。)

此处的列是原子量、熔点、沸点、密度、地壳百分比、发现年份、族和电离能。(我使用 0 表示“不适用”,事实证明这不是一个很好的选择)。

要加载 newLISP 的 SQLite 模块,请使用以下行

(load "/usr/share/newlisp/modules/sqlite3.lsp")

这将加载包含 SQLite 接口的 newLISP 源文件。它还创建一个名为 sql3 的新上下文,其中包含用于处理 SQLite 数据库的函数和符号。

接下来,我们要创建一个新数据库或打开一个现有数据库

(if (sql3:open "periodic_table") 
   (println "database opened/created")
   (println "problem: " (sql3:error)))

这将创建一个名为 periodic_table 的新 SQLite 数据库文件,并打开它。如果文件已经存在,它将被打开以供使用。您不必再次引用此数据库,因为 newLISP 的 SQLite 库例程在 sql3 上下文中维护一个 当前数据库。如果 open 函数失败,则会打印存储在 sql3:error 中的最新错误。

我刚刚创建了这个数据库,所以下一步是创建一个表。首先,我将定义一个包含列名字符串和每个列应使用的 SQLite 数据类型的符号。我不必这样做,但它可能必须写下来,因此,与其写在信封背面,不如把它写在一个 newLISP 符号中

(set 'column-def "number INTEGER, atomic_weight FLOAT,
element TEXT, symbol TEXT, mp FLOAT, bp FLOAT, density
FLOAT, earth_crust FLOAT, discovered INTEGER, egroup
INTEGER, ionization FLOAT")

现在我可以创建一个创建表的函数

(define (create-table)
 (if (sql3:sql (string "create table t1 (" column-def ")"))
    (println "created table ... OK")
    (println "problem " (sql3:error))))

这很简单,因为我刚刚以完全正确的格式创建了 column-def 符号!此函数使用 sql3:sql 函数创建一个名为 t1 的表。

我想要一个额外的函数:一个用存储在元素列表中的数据填充 SQLite 表的函数。它不是一个漂亮的函数,但它完成了工作,而且只需要调用一次。

(define (init-table)
 (dolist (e (parse elements "\n" 0))
 (set 'line (parse e))
 (if (sql3:sql 
  (format "insert into t1 values (%d,%f,'%s','%s',%f,%f,%f,%f,%d,%d,%f);" 
    (int (line 0))
    (float (line 1))
    (line 2) 
    (line 3) 
    (float (line 4)) 
    (float (line 5))
    (float (line 6))
    (float (line 7))
    (int (line 8))
    (int (line 9))
    (float (line 10))))
  ; success
  (println "inserted element " e)
  ; failure
  (println (sql3:error) ":" "problem inserting " e))))

此函数调用 parse 两次。第一个 parse 将数据分成行。第二个 parse 将每行分解成一个字段列表。然后我可以使用 format 将每个字段的值括在单引号中,记住根据列定义将字符串更改为整数或浮点数(使用 intfloat)。

现在该构建数据库了

(if (not (find "t1" (sql3:tables)))
 (and
   (create-table)
   (init-table)))

- 如果表列表中不存在 t1 表,则会调用创建和填充它的函数。

查询数据

[编辑 | 编辑源代码]

现在数据库已准备就绪。但首先,我将编写一个简单的实用程序函数来简化查询

(define (query sql-text)
 (set 'sqlarray (sql3:sql sql-text))    ; results of query
 (if sqlarray
   (map println sqlarray)
   (println (sql3:error) " query problem ")))

此函数提交提供的文本,并通过将 println 映射到结果列表上来打印结果,或显示错误消息。

以下是一些示例查询。

查找所有在 1900 年之前发现且在地壳中占比超过 2% 的元素,并按发现日期对结果进行排序

(query 
 "select element,earth_crust,discovered 
 from t1 
 where discovered < 1900 and earth_crust > 2 
 order by discovered")
("Iron" 5.05 0)
("Magnesium" 2.08 1755)
("Oxygen" 46.71 1774)
("Potassium" 2.58 1807)
("Sodium" 2.75 1807)
("Calcium" 3.65 1808)
("Silicon" 27.69 1824)
("Aluminium" 8.07 1825)

惰性气体(位于第 18 族)是什么时候发现的?

(query 
 "select symbol, element, discovered 
 from t1 
 where egroup = 18")
("He" "Helium" 1895)
("Ne" "Neon" 1898)
("Ar" "Argon" 1894)
("Kr" "Krypton" 1898)
("Xe" "Xenon" 1898)
("Rn" "Radon" 1900)

所有以 A 开头的元素的原子量是多少?

(query 
 "select element,symbol,atomic_weight 
 from t1 
 where symbol like 'A%' 
 order by element")
("Actinium" "Ac" 227)
("Aluminium" "Al" 26.9815)
("Americium" "Am" 243)
("Argon" "Ar" 39.948)
("Arsenic" "As" 74.9216)
("Astatine" "At" 210)
("Gold" "Au" 196.9665)
("Silver" "Ag" 107.8682)

这太简单了,我的亲爱的华生!也许那里的科学家可以提供一些更具科学意义的查询示例?

您也可以在网上找到 newLISP 的 MySQL 和 Postgres 模块。

简单倒计时器

[编辑 | 编辑源代码]

接下来是一个作为命令行实用程序运行的简单倒计时器。此示例展示了一些访问脚本中命令行参数的技术。

要开始倒计时,您需要输入命令(newLISP 脚本的名称)后跟一个持续时间。持续时间可以是秒;分钟和秒;小时、分钟和秒;甚至可以是天、小时、分钟和秒,用冒号隔开。它也可以是任何 newLISP 表达式。

> countdown 30
Started countdown of 00d 00h 00m 30s at 2006-09-05 15:44:17
Finish time:       2006-09-05 15:44:47
Elapsed: 00d 00h 00m 11s Remaining: 00d 00h 00m 19s

> countdown 1:30
Started countdown of 00d 00h 01m 30s at 2006-09-05 15:44:47
Finish time:       2006-09-05 15:46:17
Elapsed: 00d 00h 00m 02s Remaining: 00d 00h 01m 28s

> countdown 1:00:00
Started countdown of 00d 01h 00m 00s at 2006-09-05 15:45:15
Finish time:       2006-09-05 16:45:15
Elapsed: 00d 00h 00m 02s Remaining: 00d 00h 59m 58s

> countdown 5:04:00:00
Started countdown of 05d 04h 00m 00s at 2006-09-05 15:45:47
Finish time:       2006-09-10 19:45:47
Elapsed: 00d 00h 00m 05s Remaining: 05d 03h 59m 55s

或者,您可以提供 newLISP 表达式而不是数值持续时间。这可能是一个简单的计算,例如 π 分钟的秒数

> countdown "(mul 60 (mul 2 (acos 0)))"
Started countdown of 00d 00h 03m 08s at 2006-09-05 15:52:49
Finish time:       2006-09-05 15:55:57
Elapsed: 00d 00h 00m 08s Remaining: 00d 00h 03m 00s

或者,更有用的是,倒计时到一个特定的时间点,您可以通过从目标时间减去当前时间来提供该时间点

> countdown "(- (date-value 2006 12 25) (date-value))"
Started countdown of 110d 08h 50m 50s at 2006-09-05 16:09:10
Finish time:        2006-12-25 00:00:00
Elapsed: 00d 00h 00m 07s Remaining: 110d 08h 50m 43s

- 在此示例中,我们使用 date-value 指定了圣诞节,它返回自 1970 年以来的秒数,用于指定日期和时间。

表达式的求值由 eval-string 完成,在这里它应用于输入文本(如果它以“(”开头 - 通常表明存在 newLISP 表达式!否则,假设输入是冒号分隔的,并通过 parse 分割并转换为秒)。

信息来自命令行上给出的参数,并使用 main-args 提取,main-args 是运行程序时使用的参数列表


(main-args 2)

这将获取参数 2;参数 0 是 newLISP 程序的名称,参数 1 是脚本的名称,因此参数 2 是 countdown 命令后的第一个字符串。

将此文件保存为 countdown,并使其可执行。

#!/usr/bin/newlisp
(if (not (main-args 2))
 (begin 
   (println "usage: countdown duration [message]\n
    specify duration in seconds or d:h:m:s") 
   (exit)))
 
(define (set-duration)
; convert input to seconds
  (if (starts-with duration-input "(") 
      (set 'duration-input (string (eval-string duration-input))))
  (set 'duration 
   (dolist (e (reverse (parse duration-input ":"))) 
    (if (!= e) 
     (inc duration (mul (int e) ('(1 60 3600 86400) $idx)))))))
 
(define (seconds->dhms s)
; convert seconds to day hour min sec display
  (letn 
    ((secs (mod s 60)) 
     (mins (mod (div s 60) 60)) 
     (hours (mod (div s 3600) 24))
     (days (mod (div s 86400) 86400))) 
   (format "%02dd %02dh %02dm %02ds" days hours mins secs)))
 
(define (clear-screen-normans-way)
; clear screen using codes - thanks to norman on newlisp forum :-)
 (println "\027[H\027[2J"))
 
(define (notify announcement)
; MacOS X-only code. Change for other platforms.
  (and 
   (= ostype "OSX")
   ; beep thrice
   (exec (string {osascript -e 'tell application "Finder" to beep 3'}))
 
   ; speak announcment:
   (if (!= announcement nil) 
     (exec (string {osascript -e 'say "} announcement {"'})))
 
   ; notify using Growl:
   (exec (format 
		"/usr/local/bin/growlnotify %s -m \"Finished count down \"" 
      	(date (date-value) 0 "%Y-%m-%d %H:%M:%S")))))

(set 'duration-input (main-args 2) 'duration 0)

(set-duration)

(set 'start-time (date-value))

(set 'target-time (add (date-value) duration))

(set 'banner 
  (string  "Started countdown of " 
    (seconds->dhms duration) 
    " at " 
    (date start-time 0 "%Y-%m-%d %H:%M:%S")
    "\nFinish time:                            " 
    (date target-time 0 "%Y-%m-%d %H:%M:%S")))

(while (<= (date-value) target-time)
  (clear-screen-normans-way)
  (println 
     banner 
     "\n\n" 
    "Elapsed: " 
    (seconds->dhms (- (date-value) start-time )) 
    " Remaining: " 
    (seconds->dhms (abs (- (date-value) target-time))))
  (sleep 1000))

(println 
  "Countdown completed at " 
  (date (date-value) 0 
  "%Y-%m-%d %H:%M:%S") "\n")

; do any notifications here
(notify (main-args 3))

(exit)

编辑文件夹和层次结构中的文本文件

[编辑 | 编辑源代码]

以下是一个简单的函数,它通过查找封闭标签并将标签之间的文本更改来更新每个文件夹中的一些文本日期戳。例如,您可能有一对包含文件上次编辑日期的标签,例如 <last-edited> 和 </last-edited>。

(define (replace-string-in-files start-str end-str repl-str folder)
  (set 'path (real-path folder))
  (set 'file-list (directory folder {^[^.]}))
  (dolist (f file-list)
    (println "processing file " f)
    (set 'the-file (string path "/" f))
    (set 'page (read-file the-file))
    (replace
      (append start-str "(.*?)" end-str)  ; pattern 
       page                               ; text 
      (append start-str repl-str end-str) ; replacement 
       0)                                 ; regex option number
    (write-file the-file page)
   ))

可以像这样调用它

(replace-string-in-files 
 {<last-edited>} {</last-edited>} 
 (date (date-value) 0 "%Y-%m-%d %H:%M:%S") 
 "/Users/me/Desktop/temp/")

replace-string-in-files 函数接受一个文件夹名称。第一个任务是提取一个合适的文件列表 - 我们使用 directory 以及正则表达式{^[^.]}来排除所有以点开头的文件。然后,对于每个文件,内容都加载到一个符号中,replace 函数替换指定字符串包围的文本,最后,修改后的文本将保存回磁盘。要调用该函数,请指定起始标签和结束标签,以及文本和文件夹名称。在此示例中,我们只使用 datedate-value 提供的简单 ISO 日期戳。

递归版本

[编辑 | 编辑源代码]

假设我们现在想让它对文件夹中的文件夹中的文件夹起作用,即遍历文件层次结构,沿途更改每个文件。为此,请重构 replace-string 函数,使其在传递的路径名上起作用。然后编写一个递归函数来查找文件夹中的文件夹,并生成所有需要的路径名,并将每个路径名传递给 replace-string 函数。这种重构可能本身就是一件好事:至少它让第一个函数更简单。

(define (replace-string-in-file start-str end-str repl-str pn)
 (println "processing file " pn)
 (set 'page (read-file pn)) 
 (replace
  (append start-str "(.*?)" end-str)   ; pattern 
  page                                 ; text 
  (append start-str repl-str end-str)  ; replacement 
  0)                                   ; regex option number
 (write-file pn page))

接下来,看一下这个递归遍历树的函数。它会查看文件夹/目录中的每个普通条目,并测试它是否为目录(使用 **directory?**)。如果是,**replace-in-tree** 函数会调用自身并在新位置重新开始。如果不是,文件的路径名将传递给 **replace-string-in-file** 函数。

(define (replace-in-tree dir s e r)
 (dolist (nde (directory dir {^[^.]}))
   (if (directory? (append dir nde))
       (replace-in-tree (append dir nde "/") s e r)
       (replace-string-in-file (append dir nde) s e r))))

要更改整个树的多个文件,请像这样调用函数

(replace-in-tree 
  {/Users/me/Desktop/temp/} 
  {<last-edited>}  
  {</last-edited>} 
  (date (date-value) 0 "%Y-%m-%d %H:%M:%S"))

在开始操作之前,务必先在临时区域测试这些内容;代码中的一个小错误可能会对您的数据造成重大影响。新 LISPer 请注意!

与其他应用程序通信(MacOS X 示例)

[编辑 | 编辑源代码]

newLISP 为将具有自身脚本语言的应用程序程序中的功能粘合在一起提供了良好的环境。它速度快,体积小,不会妨碍脚本解决方案的其他组件,并且非常适合在信息通过工作流时进行处理。

以下是如何使用 newLISP 脚本将非 newLISP 脚本命令发送到应用程序的示例。任务是在 Adobe Illustrator 中构建一个圆形,给出圆周上的三个点。

解决方案分为三个部分。首先,我们从应用程序中获取选择的坐标。接下来,我们计算通过这些点的圆的半径和圆心点。最后,我们可以绘制圆形。第一部分和最后部分使用 AppleScript,它使用 `osascript` 命令运行,因为 Adobe Illustrator 不理解任何其他脚本语言(在 Windows 上,您使用的是 Visual Basic 而不是 AppleScript)。

Using a newLISP script in Adobe Illustrator

使用 newLISP 进行计算和一般接口。这通常比使用原生 AppleScript 更好,因为 newLISP 提供了许多在默认 AppleScript 系统中找不到的强大的字符串和数学函数。例如,如果我想使用三角学,我需要查找并安装额外的组件 - AppleScript 根本不提供任何三角函数。

newLISP 脚本可以放在菜单栏上的“脚本”菜单中;将其放到“库”>“脚本”>“应用程序”>“Adobe Illustrator”文件夹中,该文件夹接受文本文件和 AppleScript)。然后,它可以在您在 Illustrator 中工作时选择使用。要使用它,只需选择至少包含三个点的路径,然后运行脚本。前三个点定义新圆形的位置。

#!/usr/bin/newlisp

; geometry routines from
; http://cgafaq.info/wiki/Circle_Through_Three_Points
; given three points, draw a circle through them

(set 'pointslist 
  (exec 
    (format [text]osascript  -e 'tell application "Adobe Illustrator 10"
  tell front document
    set s to selection
    repeat with p in s
    set firstItem to p
    set pathinfo to entire path of firstItem
    set pointslist to ""
    repeat with p1 in pathinfo
    set a to anchor of p1
    set pointslist to pointslist & " " & item 1 of a
    set pointslist to pointslist & " " & item 2 of a
    end repeat
    end repeat
  end tell
end tell
pointslist' 
[/text])))

; cleanup
(set 'points 
  (filter float? 
    (map float (parse (first pointslist) { } 0))))

(set  'ax (points 0) 
      'ay (points 1) 
      'bx (points 2) 
      'by (points 3) 
      'cx (points 4) 
      'cy (points 5))

(set  'A (sub bx ax)
      'B (sub by ay)  
      'C (sub cx ax)  
      'D (sub cy ay)
      'E (add 
          (mul A (add ax bx)) 
          (mul B (add ay by)))
      'F (add 
          (mul C (add ax cx)) 
          (mul D (add ay cy)))
      'G (mul 2 
            (sub 
              (mul A (sub cy by)) 
              (mul B (sub cx bx)))))

(if (= G 0) ; collinear, forget it
  (exit))

(set  'centre-x (div (sub (mul D E) (mul B F)) G)
      'centre-y (div (sub (mul A F) (mul C E)) G)
      'r 
        (sqrt 
          (add 
            (pow (sub ax centre-x)) 
            (pow (sub ay centre-y)))))

; we have coords of centre and the radius 
; in centre-x, centre-y, and r
; Illustrator bounds are left-x, top-y, right-x, bottom-y 
; ie centre-x - r, centre-y + r, centre-x + r, centre-y -r 

(set 'bounds-string 
  (string "{" (sub centre-x r) ", " 
   (add centre-y r) ", " 
   (add centre-x r) ", " 
   (sub centre-y r) "}"))

(set 'draw-circle 
  (exec (format [text]osascript  -e 'tell application "Adobe Illustrator 10"
  tell front document
    set e to make new ellipse at beginning with properties {bounds:%s}
  end tell
end tell
' 
[/text] bounds-string)))
(exit)

此脚本几乎没有错误处理!在第一阶段应该添加更多错误处理(因为选择可能不适合后续处理)。

华夏公益教科书