-- charset="CP932"
-- encoding="CP932"
=============
Date and Time
=============
Macintosh の System や HyperCard に用意されてゐないけれど Internet で
必要になる Date の format で返す。
--
localtime( [ iso8601 | rfc1123 | rfc850 | asctime ] [, datetime ] )
--
第 1 引数は Format type。省略すると単に Dateitems になってしまう丈け。
第 2 引数は datetime (convert 出来る時間文字列)。省略すると呼び出した
日時になる。convert は CallBack するので入れたくなかったが、dateitems
を渡すのも面倒だということで。
Time Zone は其の都度追加する等、各自工夫してください。
CompileIt! Demo で Compile する為に |the numberFormat| を使わない樣に
してみた。
--
function localtime t, d
if d is not empty then
get d
else
get the seconds
end if
put "Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec," & return & "Sun,Mon,Tues,Wednes,Thurs,Fri,Satur" into s
convert it to dateitems
repeat with i = 2 to 6
if the length of item i of it < 2 then put "0" before item i of it
end repeat
if t is "iso8601" then
get item 1 of it & "-" & item 2 of it & "-" & item 3 of it & "T" & item 4 of it & colon & item 5 of it & colon & item 6 of it
else if t is "rfc1123" then
get character 1 to 3 of item (item 7 of it) of line 2 of s & comma && item 3 of it && item (item 2 of it) of s && item 1 of it && item 4 of it & colon & item 5 of it & colon & item 6 of it
else if t is "rfc850" then
get item (item 7 of it) of line 2 of s & "day," && item 3 of it & "-" & item (item 2 of it) of s & "-" & item 1 of it && item 4 of it & colon & item 5 of it & colon & item 6 of it
else if t is "asctime" then
get character 1 to 3 of item (item 7 of it) of line 2 of s && item (item 2 of it) of s && item 3 of it && item 4 of it & colon & item 5 of it & colon & item 6 of it && item 1 of it
end if
return it
end localtime
--
序でに MikeTime
というのも作ってみた。
--
MikeTime( [ datetime ] )
--
旧 Mac OS では File name に使うと具合が宜しく無いのですが、
Case Sensitive HFS+ で Format した環境では一応使えるんでは?
--
function MikeTime t
if t is empty or t is not a date then put the seconds into t
put "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" into MikeBASE60
convert t to dateitems
return character (1 + character 1 to 2 of item 1 of t) of MikeBASE60 & character 3 to 4 of item 1 of t & "-" & character (1 + item 2 of t) of MikeBASE60 & character (1 + item 3 of t) of MikeBASE60 & "-" & character (1 + item 4 of t) of MikeBASE60 & character (1 + item 5 of t) of MikeBASE60 & character (1 + item 6 of t) of MikeBASE60
end MikeTime
--
* ISO/IEC 8601:2000
* RFC 822 J
* RFC 850
* RFC 1036 J
* RFC 1123 J
* RFC 2550 J
* RFC 2822 J
* programming and calendar
* MikeTime
=================
Julian Day Number
=================
なんでも天文學ではユリウス日数というのを使う相で、計算に便利らしいので
関数を作ってみました。
|jdn( YYYY, MM, DD )|
--
function jdn y, m, d
return d - 32075 + (1461 * (y + 4800 + ((m - 14) div 12)) div 4) + (367 * (m - 2 - ((m - 14) div 12) * 12) div 12) - (3 * ((y + 4900 + ((m - 14) div 12)) div 100) div 4)
end jdn
--
確かにちゃんと計算できるみたい (Moon Tool で確認) ですが、何でこう
為るのか解って無かったりします (--;;
* 日数の計算 (元の AWK Script)
* suchowan
* 星の神殿
* 暦もの のページ
* The Julian Date Project
* Julian Day Numbers
* Moon Tool
==================
Max Char, Min Char
==================
max(), min(), は數値しか受け付けないので User Handler を書いてしまいました。
--
function maxc
get param(1)
repeat with i = 2 to the paramCount
if param(i) > it then get param(i)
end repeat
return it
end maxc
--
function minc
get param(1)
repeat with i = 2 to the paramCount
if param(i) < it then get param(i)
end repeat
return it
end minc
--
これだと、16 進法も扱えてゐるみたいです。但し、大文字小文字は區別
できませんね。3 項以上の場合にも對應しました。
====================
Quasi Absolute Value
====================
abs() は double_t を超えて扱うことが出來ないので文字列処理で誤魔化して
みました。
--
function qabs n
if n is a number and n >= 0 then return n
repeat with i = the number of characters of n down to 1
if character i of n is not in ".0123456789" then delete character i of n
end repeat
return n
end qabs
--
胡散臭い処理ですね。
* PowerPC Numerics (IM:PN)
=====
Radix
=====
"? 進 ⇔ 10 進" 変換の内、Toolbox で用意されてゐるのは 16 進法ぐらい
ではないかと思うのですが、他にも何か必要になる亊も在るかもしれなくも
ない氣がしそうな感じみたいな雰囲気っぽい気配。
"? 進 ⇒ ? 進" も作っておいて……。
--
function anyToAny s, rb, ra
if s is empty or s is "?" then
return "Error: anyToAny(number string, before radix, after radix)"
else if rb is ra then
return s
end if
return numToAny(anyToNum(s, rb), ra)
end anyToAny
--
function anyToNum s, r
if s is empty or s is "?" then
return "Error: _anyToNum(number string, radix)"
else if s contains "Error" then
return s
else if character 1 to 2 of s is "0x" then
put 16 into r
else if character 1 of s is "0" then
put 8 into r
end if
if r is empty or r = 10 then
return s
else if r < 2 or r > 33 then
return "Error: Invalid radix. from 2 to 33 only."
end if
put 0 into n
repeat with i = 1 to the number of characters of s
multiply n by r
add offset(character i of s, "123456789ABCDEFGHIJKLMNOPQRSTUVW") to n
end repeat
return n
end anyToNum
--
或いは其の逆。2147483647 以上は 負の價になるので Error.
--
function numToAny n, r
if n is empty or n is "?" then
return "Error: _numToAny(number string, radix)"
else if n is not an integer then
return n
else if n > 2147483647 then
return "Error: Overflow Signed Long (31 bit)."
end if
if r is empty or r = 10 then
return n
else if r < 2 or r > 33 then
return "Error: Invalid radix. from 2 to 33 only."
end if
put empty into s
repeat while n > 0
put character (1 + n mod r) of "0123456789ABCDEFGHIJKLMNOPQRSTUVW" before s
put n div r into n
end repeat
if s is empty then
put 0 into s
end if
if r = 16 then
return "0x" & s
else if r = 8 then
return "0" & s
else
return s
end if
end numToAny
--
================
Initial Capitals
================
Alphabet の Words の先頭一文字を全て大文字にします。
--
function cw s
put 0 into n
repeat with i = 1 to the number of characters of s
get the charToNum of (character i of s)
if (it >= 129 and it <= 159) or (it >= 224 and it <= 234) then
put (i + 1) into n
else if (n = i) or (it < 65) or (it > 90 and it < 97) or (it > 122) then
put 0 into n
else if (n <> 0 and it >= 65 and it <= 90) then
put the numToChar of (it + 32) into character i of s
else if (n = 0) then
put i into n
if (it >= 97 and it <= 122) then
put the numToChar of (it - 32) into character i of s
end if
end if
end repeat
return s
end cw
--
云、簡単に出来た。但し、大きな文字列を character 単位で捜査すると
*ものごっつい* 時間が掛かる。通常 HyperTalk でこういう操作を行う
場合は、|lines| 等で 区切って処理すると速くなる。
CompileIt! Demo で Compile するには 1 行多いので、最初の 0 の代入を
消して、n を參照する部分を |(0 + n)| にすれば良い。
=========
lowercase
=========
Alphabet の小文字変換も awk 等では |tolower()|, Perl では |lc()|,
で出来る。在れば便利そうなので作ってみよう。
--
function lc s
put 0 into n
repeat with i = 1 to the number of characters of s
if n is i then
next repeat
end if
get the charToNum of (character i of s)
if (it < 65) or (it > 234) then
next repeat
else if (it >= 65 and it <= 90) then
put the numToChar of (it + 32) into character i of s
else if (it >= 129 and it <= 159) or (it >= 224 and it <= 234) then
put (i + 1) into n
end if
end repeat
return s
end lc
--
=========
UPPERCASE
=========
Alphabet の UPPERCASE 変換も awk 等では |toupper()|, Perl では |uc()|,
で出来る。在れば便利そうなので作ってみよう。
--
function uc s
put 0 into n
repeat with i = 1 to the number of characters of s
if n is i then
next repeat
end if
get the charToNum of (character i of s)
if (it < 97) or (it > 234) then
next repeat
else if (it >= 97 and it <= 122) then
put the numToChar of (it - 32) into character i of s
else if (it >= 129 and it <= 159) or (it >= 224 and it <= 234) then
put (i + 1) into n
end if
end repeat
return s
end uc
--
========
chipChop
========
指定した文字が連續した場合、一つに纏めます。
--
function chipChop c, s
repeat with i = 1 to the number of characters of c
get (character i of c & character i of c)
repeat until it is not in s
delete character offset(it, s) of s
end repeat
end repeat
return s
end chipChop
--
=============
Cols <-> Rows
=============
表データの縦横を入れ替える。
|cols_to_rows(itemDelimiter, data)|
--
function cols_to_rows d, cols, rows
set the itemDelimiter to d
repeat with x = 1 to the number of lines of cols
repeat with i = 1 to the number of items of line x of cols
get item i of line x of cols
if it is empty then next repeat
if the number of items of line i of rows < (x - 1) then
put empty after item x of line i of rows
end if
put it into item x of line i of rows
end repeat
end repeat
set the itemDelimiter to comma
return rows
end cols_to_rows
--
上記の場合は itemDelimiter が 2 bytes 以上だと使えないので replace()
で一旦 formFeed (the numToChar of 12) に置き換える方法も。
--
function cols_2_rows d, cols, rows
set the itemDelimiter to formFeed
repeat with x = 1 to (the number of lines of cols)
put replace(line x of cols, d, formFeed) into temp
repeat with i = 1 to (the number of items of temp)
get item i of temp
if it is empty then next repeat
if the number of items of line i of rows < (x - 1) then
put empty after item x of line i of rows
end if
put it into item x of line i of rows
end repeat
end repeat
set the itemDelimiter to comma
return replace(rows, formFeed, d)
end cols_2_rows
--
================
CR/LF Conversion
================
最初に internet 標準の |0x0D 0x0A| を return に、次に unix で多く
使われる |0x0A| を return にします。sed や perl で書いたりすると
--
s/\x0D\x0A/\n/g;
y/\x0D\x0A/\n\n/;
--
と短いですが、HyperTalk ではこうなります (一例ですが)。
--
function crlf _
repeat until (return & lineFeed) is not in _
delete character (offset(return & lineFeed, _) + 1) of _
end repeat
repeat until lineFeed is not in _
put return into character (offset(lineFeed, _)) of _
end repeat
return _
end crlf
--
|0x0D 0x0A| の場合は、return の後にくっついた lineFeed 丈け削除します。
|0x0A| 丈けの場合は、単に return に置き換える丈け。
lineFeed 丈けだった場合は、最初の repeat は實行されず、return +
lineFeed の場合は、次の repeat は實行されませんので、そこそこ効率も悪く
ない筈なんですけど、日本語環境では無限 Loop してしまう場合がありました。
んでまぁ一應、修正版。
--
function crlf s, t
repeat until (return & lineFeed) is not in s
delete character (offset(return & lineFeed, s) + 1) of s
end repeat
repeat until lineFeed is not in s
put character 1 to (offset(lineFeed, s) - 1) of s & return after t
delete character 1 to offset(lineFeed, s) of s
end repeat
return t
end crlf
--
========
DeAccent
========
Accent 記號附きの Alphabet を Low ASCII にします。
--
function deaccent s
repeat with i = 1 to the number of characters of s
get the charToNum of (character i of s)
if (it < 129) then
next repeat
else if (it = 129) or (it = 203) or (it = 204) or (it = 229) or (it = 231) then
put "A" into character i of s
else if (it >= 135 and it <= 140) then
put "a" into character i of s
else if (it = 130) then
put "C" into character i of s
else if (it = 141) then
put "c" into character i of s
else if (it = 131) or (it = 230) or (it = 232) or (it = 233) then
put "E" into character i of s
else if (it >= 142 and it <= 145) then
put "e" into character i of s
else if (it >= 234 and it <= 237) then
put "I" into character i of s
else if (it >= 146 and it <= 149) then
put "i" into character i of s
else if (it = 132) then
put "N" into character i of s
else if (it = 150) then
put "n" into character i of s
else if (it = 133) or (it = 205) or (it = 238) or (it = 239) or (it = 241) then
put "O" into character i of s
else if (it >= 151 and it <= 155) then
put "o" into character i of s
else if (it = 134) or (it >= 242 and it <= 244) then
put "U" into character i of s
else if (it >= 156 and it <= 159) then
put "u" into character i of s
else if (it = 216) then
put "y" into character i of s
else if (it = 217) then
put "Y" into character i of s
end if
end repeat
return s
end deaccent
--
============
Indent Shift
============
Menu を作って |the commandChar| を設定しておけば、Key 操作で Indent を
ちょいちょいと。
ま、例へばこんな Menu を作って……
--
set the commandChar of menuItem "shift right" of menu it to "]"
set the commandChar of menuItem "shift left" of menu it to "["
--
こんな function を作ってみるとか。
--
on shift lr
put the selectedField into tsf
put the selectedChunk into tsc
if tsf is empty or tsc is empty then exit shift
do "put the number of lines of character 1 to (word 2 of tsc) of tsf into x" & return & "put the number of lines of character 1 to (word 4 of tsc) of tsf into y"
do "get line x to y of tsf"
set the lockScreen to true
repeat with i = 1 to (the number of lines of it)
if lr is "right" then
if the number of words of line i of it < 1 then next repeat
put (space & space & space & space) before line i of it
else
delete character 1 to min(4, offset(word 1 of line i of it, line i of it) - 1) of line i of it
end if
end repeat
do "put it into line x to y of tsf"
set the lockScreen to false
do "select line x to y of tsf"
end shift
--
===========
Offset List
===========
何に使うのかという疑問も在りそうですが。
data に含まれる全ての string の位置の list を
|offsetList( string, data )| で得る。
--
function offsetList s, t, d
if d is empty then
put return into d
end if
put 1 into i
repeat forever
get offset(s, character i to (the number of characters of t) of t) - 1
if it < 0 then
exit repeat
else if list is not empty then
put d & (it + i) after list
else
put (it + i) into list
end if
add (it + the number of characters of s) to i
end repeat
return list
end offsetList
--
===========
Quasi Quote
===========
HyperTalk で HTML を扱ったりする際、面倒なのが Quote の扱いです。
通常 Script 内の文字列で Double Quote を使用する場合は
|quote & "ほにゃらら" & quote|
と、なる譯ですが、これがあんまり多いとうんざりするし、Script も汚く
なります。
それで、疑似 Quote 風(?)に書けるように qq という関数を使ってみました。
--
function qq str
return quote & str & quote
end qq
--
これだと、先程の Sample も
--
qq("ほにゃらら")
--
と、書けてしまいます。どうでしょうか?
===========
Range Chars
===========
the numberFormat の Format String を作るのは簡単且つ面倒なので、
function にして再利用してゐるのですが、XFCN にしてみたらどうかと思っ
て、CompileIt! Demo でやってみると 4, 5 倍遲くなり、遣るだけ無駄でした。
というか、時間を計測してみたら HyperTalk で十分速かった譯ですが。
例: |set the numberFormat to rangeChars(4, "0") & "." & rangeChars(6)|
--
function rangeChars r, c
if r is not an integer or r < 1 then return empty
if c is empty then put "#" into c
get empty
set the itemDelimiter to c
put c after item r of it
set the itemDelimiter to comma
return it
end rangeChars
--
=======
Replace
=======
HyperCard でも |join( string, list )| や |split( separator, data )| が
使えたら便利だと思ったのですが、よくよく考えたら HyperCard では両方単なる
文字列の置き換えだったので、|replace(data, before, after)| にしました。
--
function replace s, o, n, r
put (the number of characters of o) - 1 into p
get offset(o, s)
repeat while it is not 0
put character 1 to (it - 1) of s & n after r
delete character 1 to (it + p) of s
get offset(o, s)
end repeat
return r & s
end replace
--
==============
Reverse Offset
==============
string の中で text が最後に出現する位置を返します。繰返版と再帰版が
あります。やっぱり HyperCard では再帰を使うと遅くなるみたいです。
|roffset(TEXT, STRING [, LIMIT ] )|
再帰版
--
function rroffset t, s, L
if L is not empty then
put min(0 + l, the number of characters of s) into L
else
put the number of characters of s into L
end if
get offset(t, character 1 to L of s)
if it is not 0 then
add rroffset(t, character (it + 1) to L of s, empty) to it
end if
return it
end rroffset
--
繰返版
--
function roffset t, s, L
if L is not empty then
put min(0 + l, the number of characters of s) into L
else
put the number of characters of s into L
end if
put 0 into p
repeat forever
get offset(t, character (p + 1) to L of s)
if it = 0 then
exit repeat
end if
add it to p
end repeat
return p
end roffset
--
roffset を使って STRING 全体を末尾から先頭に向かって調べる
--
get the number of chars of STRING
repeat while it <> 0
get roffset(TEXT, STRING, it - 1)
if it <> 0 then put it & comma after msg
end repeat
--
=========
ROT-13/47
=========
ROT-13/47 Conversion を行います。
param(2) に empty 以外を渡すと多バイト文字であらうと Convert します。
--
function rot13 s, b
put 0 into n
repeat with i = 1 to the number of characters of s
if n is i then
next repeat
end if
get the charToNum of (character i of s)
if (it < 65) or (it > 234) then
next repeat
else if (it >= 65 and it <= 77) or (it >= 97 and it <= 109) then
put numToChar of (it + 13) into character i of s
else if (it >= 78 and it <= 90) or (it >= 110 and it <= 122) then
put numToChar of (it - 13) into character i of s
else if ((it >= 129 and it <= 159) or (it >= 224 and it <= 234)) and b is empty then
put (i + 1) into n
end if
end repeat
return s
end rot13
--
function rot47 s, b
put 0 into n
repeat with i = 1 to the number of characters of s
if n is i then
next repeat
end if
get the charToNum of (character i of s)
if (it < 33) or (it > 234) then
next repeat
else if (it >= 33 and it <= 78) then
put numToChar of (it + 47) into character i of s
else if (it >= 79 and it <= 126) then
put numToChar of (it - 47) into character i of s
else if ((it >= 129 and it <= 159) or (it >= 224 and it <= 234)) and b is empty then
put (i + 1) into n
end if
end repeat
return s
end rot47
--
=======
snippet
=======
文字列から指定した文字(複数可)を全て削除します。
--
function snippet c, s
repeat with i = 1 to (the number of characters of c)
get character i of c
repeat until it is not in s
delete character offset(it, s) of s
end repeat
end repeat
return s
end snip
--
=====================
Tab Expand / UnExpand
=====================
Field は Tab Width の設定ができないというか tab と space の見分けが
つかないので、変換するしか手が無いと思うのですが、どうでしょう?
--
function tabExpand s, t
if 0 + t <= 0 then put 8 into t
repeat while s contains tab
put the number of lines of character 1 to offset(tab, s) of s into L
repeat while line L of s contains tab
set the cursor to busy
get offset(tab, line L of s)
repeat t - the length of (character 1 to (it - 1) of line L of s) mod t
put space after character it of line L of s
end repeat
delete character it of line L of s
end repeat
end repeat
return s
end tabExpand
--
一應、TEXT 書き出し用に UnExpand も作ってみました。というか 作成途中の
心算が Debugger で確認したら既に出来てしまってゐたみたいなんですけど、
本当にちゃんと動くのかなぁ…… ?
--
function tabUnExpand s, t
if 0 + t <= 0 then put 8 into t
if s contains tab then put tabExpand(s, t) into s
repeat with i = the number of lines of s down to 1
set the cursor to busy
put empty into b
put empty into e
repeat with c = the number of characters of line i of s down to 1
get character c of line i of s
if it is space then
put c mod t into m
if m = 0 then put c into e
if e is not empty then put c into b
if m is not 1 then next repeat
end if
if b is empty or e is empty then next repeat
if b < (e - 1) then put tab into character b to e of line i of s
put empty into b
put empty into e
end repeat
end repeat
return s
end tabUnExpand
--
==========
URL Decode
==========
既に XFCN 等も在るので態々作る意味も別に無いのですが、敢えて HyperTalk
でと云う亊で。變梃な Script になってますけど。
"+" になった Space を戻すの忘れてましたね。
repeat 内の書き戻しで失敗してたので修正。
--
function urldecode str
put "0123456789ABCDEF" into hexd
set the itemDelimiter to "%"
repeat with i = the number of items of str down to 2
set the cursor to busy
repeat while item i of str contains "+"
put space into character offset("+", item i of str) of item i of str
end repeat
put the number of characters of item i of str into len
get character 1 to 2 of item i of str
put offset(character 1 of it, hexd) - 1 into c1
put offset(character 2 of it, hexd) - 1 into c2
if len >= 2 and c1 >= 0 and c2 >= 0 then
get the numToChar of (c1 * 16 + c2) & character 3 to len of item i of str
delete item i of str
put it after item (i - 1) of str
end if
end repeat
set the itemDelimiter to comma
return str
end urldecode
--
=========
HTTP Spec
=========
文字列から URL を取り出すと云っても、存在する URI かどうかは調べる訳でも
無く、URL と為り得る文字列の List を返すだけですので、後処理が必要です。
--
function httpSpec s
put return into c
repeat with i = (the number of characters of s) down to 1
if character i of s is not in "!#$%&'()*+,-./0123456789:;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz~" then
if c is not return then
put return into c
else
put empty into c
end if
put c into character i of s
else
put character i of s into c
end if
end repeat
return s & return
end httpSpec
--
CompileIt! Demo の 10 行制限に収める為に、あまり速い処理に 出来ません
でした ので、効率的に使う為に出来るだけ短い (URL を含むと思われる)
文字列を渡してください。
実際に呼び出す場合はこんな感じ……
--
:
:
repeat with i = 1 to the number of lines of my_string
set the cursor to busy
put httpSpec(line i of my_string) into my_list
repeat with L = the number of lines of my_list down to 1
get line L of my_list
if char 1 to 6 of it is "ftp://" or char 1 to 7 of it is "ftps://" or char 1 to 7 of it is "http://" or char 1 to 8 of it is "https://"
then put "" & it & "" into line L of my_list
else delete line L of my_list
end repeat
put my_list after bg fld 1
end repeat
:
:
--
jgawk の方が得意そうな処理なので |request| を送る Script も追加 して
みました。遲い Machine でも結構速いです。
--
function jgawk_urllist awk_str
put "jgawk '{ gsub(/[^\041\043-\073\075\077-\132\137\141-\172\176]+/," && quote & "\n" & quote & "); print; }'" into my_request
if awk_str is not empty
then put " <<" & return & awk_str & return after my_request
put "jgawk" into JGAWK
open JGAWK
if the result is not empty then
answer the result
exit jgawk_urllist
end if
request my_request of program JGAWK
if the result is not empty
then put "jgawk error:" && the result
close JGAWK
return it
end jgawk_urllist
--
===========
Auto Indent
===========
HyperCard でちょっとした Editor を作るのは簡単ですが、その際
Auto Indent くらいは欲しい事もある。これは、改行を入力した時の
イベント |returnInField| に Script を仕込む。置く場所は Field
でも Background でも良い。
--
on returnInField
autoIndent
end returnInField
--
Auto Indent は 入力した位置 |the selectedChunk| に改行を挿入後、入力
した行 |the selectedLine| の行頭にある空白を取得し追加する。動作は
遅いです。
--
on autoIndent
put the selectedLine into L
put return into the selectedChunk
put the value of L into s
if the optionKey is down then
get empty
else if the number of words of s < 1 then
get s
else
get character 1 to (offset(character 1 of word 1 of s, s) - 1) of s
end if
add 1 to word 2 of L
select before L
type it
end autoIndent
--
XCMD にしてみましたが、2 bytes の空白は Indent に使えないものの、僅かに
速くなった氣がします。HyperTalk で書いた場合は 2 bytes の空白も処理でき
ます。
逆に Indent を除去する場合は 行頭の空白を削除するだけなので
|repeat ( while, until )| で廻せば良い。
行頭が空白だけでない (行番号や引用符が付いてる等) ならば、文字数で削除
しても便利かもしれない。
--
function force_del_indent len, dat
repeat with i = (the number of lines of dat) down to 1
delete character 1 to len of line i of dat
end repeat
return dat
end force_del_indent
--
==============
read from file
==============
TEXT file から読み込んで、データを Field に格納するのも、処理手順を
2 つ準備しておけば、殆どの場合使い回しが出來ます。
File 選択。
--
function answer_file desc, type
answer file desc of type "TEXT", "ttro", type
if the result is not empty then
exit to HyperCard
end if
return it
end answer_file
--
File 読み込み。
--
function read_from_file FH
open file FH
if the result is not empty then
answer the result
exit to HyperCard
end if
read from file FH until EOF
close file FH
return crlf(it)
end read_from_file
--
この 2 つで簡単に処理出来ます。
--
put read_from_file(answer_file("File 選択:", "HTML")) into bg fld id 2
--
File 選択処理では、追加の File Type を一つだけにする亊で処理を単純化して
ゐます。引数を可變にした時の処理を考えると:
--
if the paramCount = 1 then
answer file desc
else if the paramCount = 2 then
answer file desc of type param(2)
else if the paramCount = 3 then
answer file desc of type param(2), param(3)
else if the paramCount = 4 then
answer file desc of type param(2), param(3), param(4)
:
:
:
end if
--
などという不細工なものに為ってしまいます。本当は the params を渡して
処理できれば…… AppleSciprt を使えば出来そうですが、どうでしょうね。
File 読み込み処理では、讀み込んだ Text を返す前に 改行変換してゐます。
=============
write to file
=============
データを TEXT file に保存するのに、処理手順を 2 つ準備しておけば、殆どの
場合使い回しが出來ます。
(必要ならば) 保存する File の Path を得る。
--
function ask_file desc, def
ask file desc with def
if the result is not empty then
exit to HyperCard
end if
return it
end ask_file
--
File に Data を書き出す。
--
on write_to_file FH, ref
open file FH
if the result is not empty then
answer the result
exit to HyperCard
end if
write the value of ref to file FH
if the result is not empty then
answer the result
end if
close file FH
end write_to_file
--
この 2 つで簡単になります。|value| が使えない場合は Data を渡す等、適当に。
--
write_to_file ask_file("保存 File:", "Untitled"), "bg fld id 1"
--
==================
files open / close
==================
複數 File を同時に open / close する爲に澤山書き並べて、Error 処理まで
含めてしまうと長くなりますので纏めてみましょう。
--
on open_files
repeat with i = 1 to (the paramCount)
open file param(i)
if the result is not empty then
answer the result
exit to HyperCard
end if
end repeat
end open_files
--
on close_files
repeat with i = 1 to (the paramCount)
close file param(i)
if the result is not empty then
answer the result
end if
end repeat
end close_files
--
open するか close するか以外は全く同じですが、入出力でトラブルは避け
たいので愼重になってゐます。兩方纏めると、第 1 引数に open / close を
渡すとかでしょうか。
--
on open_close_files act
repeat with i = 2 to (the paramCount)
do (act && "file" && param(i))
if the result is not empty then
answer the result
exit to HyperCard
end if
end repeat
end open_close_files
--
多分大丈夫なんでしょうけど、なんかあまり使い度い氣持がしません。
=============
answer folder
=============
Folder を選擇したい場合、Version 2.3 以降では |answer folder| が使える
のですが、2.2.1 Lite 等を使ってゐる場合 Error になってしまいます。
勿論、Folder を選擇する XFCN を使っても良いのですが、AppleScript で
|choose folder| を使えば同様な処理が出来ます。
--
function select_folder
if the version of HyperCard >= 2.3 then
answer folder "Select Folder:"
if the result is empty
then
else exit to HyperCard
else if there is a scriptingLanguage "AppleScript" then
get "try" & return & "return (choose folder) as text" & return & "on error" & return & "end try"
do it as AppleScript
if the result is not empty
then get the result
else exit to HyperCard
else
ask file "Move into Select Folder:" with "Here"
if the result is not empty then exit to HyperCard
set the itemDelimiter to colon
put empty into last Item of it
set the itemDelimiter to comma
end if
return it
end select_folder
--
AppleScript も利用できなかった場合も、一應それなりに使えるようにしたい
ので、|ask file| で嘘の 保存ダイアログを出して、なんとかしようとしてゐ
ます。
=====
Paths
=====
Home stack の Search Paths は、放って置くと結構 重複したりして管理が面倒
ですので、closeField Handler に一寸 Script を追加して、多少でも手間を省
きたい処です。
--
:
:
put the value of word 2 of the long name of this stack into relPath
set the itemDelimiter to colon
put the number of items of relPath into x
put empty into colons
repeat with i = 1 to (x - 1)
delete last item of relPath
repeat with L = the number of lines of me down to 1
if offset(relPath, line L of me) = 1
then put colons into item 1 to (x - i) of line L of me
end repeat
put colon before colons
end repeat
set the itemDelimiter to comma
sort me
put empty into character 1 to (offset(word 1 of me, me) - 1) of me
repeat with L = the number of lines of me down to 1
if line L of me is line (L - 1) of me then delete line L of me
end repeat
:
:
--
なんかイマイチですね。