Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
393
Task/Box-the-compass/AppleScript/box-the-compass-1.applescript
Normal file
393
Task/Box-the-compass/AppleScript/box-the-compass-1.applescript
Normal file
|
|
@ -0,0 +1,393 @@
|
|||
use framework "Foundation"
|
||||
use scripting additions
|
||||
|
||||
-- BOXING THE COMPASS --------------------------------------------------------
|
||||
|
||||
property plstLangs : [{|name|:"English"} & ¬
|
||||
{expansions:{N:"north", S:"south", E:"east", W:"west", b:" by "}} & ¬
|
||||
{|N|:"N", |NNNE|:"NbE", |NNE|:"N-NE", |NNENE|:"NEbN", |NE|:"NE", |NENEE|:"NEbE"} & ¬
|
||||
{|NEE|:"E-NE", |NEEE|:"EbN", |E|:"E", |EEES|:"EbS", |EES|:"E-SE", |EESES|:"SEbE"} & ¬
|
||||
{|ES|:"SE", |ESESS|:"SEbS", |ESS|:"S-SE", |ESSS|:"SbE", |S|:"S", |SSSW|:"SbW"} & ¬
|
||||
{|SSW|:"S-SW", |SSWSW|:"SWbS", |SW|:"SW", |SWSWW|:"SWbW", |SWW|:"W-SW"} & ¬
|
||||
{|SWWW|:"WbS", |W|:"W", |WWWN|:"WbN", |WWN|:"W-NW", |WWNWN|:"NWbW"} & ¬
|
||||
{|WN|:"NW", |WNWNN|:"NWbN", |WNN|:"N-NW", |WNNN|:"NbW"}, ¬
|
||||
¬
|
||||
{|name|:"Chinese", |N|:"北", |NNNE|:"北微东", |NNE|:"东北偏北"} & ¬
|
||||
{|NNENE|:"东北微北", |NE|:"东北", |NENEE|:"东北微东", |NEE|:"东北偏东"} & ¬
|
||||
{|NEEE|:"东微北", |E|:"东", |EEES|:"东微南", |EES|:"东南偏东", |EESES|:"东南微东"} & ¬
|
||||
{|ES|:"东南", |ESESS|:"东南微南", |ESS|:"东南偏南", |ESSS|:"南微东", |S|:"南"} & ¬
|
||||
{|SSSW|:"南微西", |SSW|:"西南偏南", |SSWSW|:"西南微南", |SW|:"西南"} & ¬
|
||||
{|SWSWW|:"西南微西", |SWW|:"西南偏西", |SWWW|:"西微南", |W|:"西"} & ¬
|
||||
{|WWWN|:"西微北", |WWN|:"西北偏西", |WWNWN|:"西北微西", |WN|:"西北"} & ¬
|
||||
{|WNWNN|:"西北微北", |WNN|:"西北偏北", |WNNN|:"北微西"}]
|
||||
|
||||
-- Scale invariant keys for points of the compass
|
||||
-- (allows us to look up a translation for one scale of compass (32 here)
|
||||
-- for use in another size of compass (8 or 16 points)
|
||||
-- (Also semi-serviceable as more or less legible keys without translation)
|
||||
|
||||
-- compassKeys :: Int -> [String]
|
||||
on compassKeys(intDepth)
|
||||
-- Simplest compass divides into two hemispheres
|
||||
-- with one peak of ambiguity to the left,
|
||||
-- and one to the right (encoded by the commas in this list):
|
||||
set urCompass to ["N", "S", "N"]
|
||||
|
||||
-- Necessity drives recursive subdivision of broader directions, shrinking
|
||||
-- boxes down to a workable level of precision:
|
||||
script subdivision
|
||||
on |λ|(lstCompass, N)
|
||||
if N ≤ 1 then
|
||||
lstCompass
|
||||
else
|
||||
script subKeys
|
||||
on |λ|(a, x, i, xs)
|
||||
-- Borders between N and S engender E and W.
|
||||
-- further subdivisions (boxes)
|
||||
-- concatenate their two parent keys.
|
||||
if i > 1 then
|
||||
cond(N = intDepth, ¬
|
||||
a & {cond(x = "N", "W", "E")} & x, ¬
|
||||
a & {item (i - 1) of xs & x} & x)
|
||||
else
|
||||
a & x
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
|λ|(foldl(subKeys, {}, lstCompass), N - 1)
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
tell subdivision to items 1 thru -2 of |λ|(urCompass, intDepth)
|
||||
end compassKeys
|
||||
|
||||
-- pointIndex :: Int -> Num -> String
|
||||
on pointIndex(power, degrees)
|
||||
set nBoxes to 2 ^ power
|
||||
set i to round (degrees + (360 / (nBoxes * 2))) ¬
|
||||
mod 360 * nBoxes / 360 rounding up
|
||||
cond(i > 0, i, 1)
|
||||
end pointIndex
|
||||
|
||||
-- pointNames :: Int -> Int -> [String]
|
||||
on pointNames(precision, iBox)
|
||||
set k to item iBox of compassKeys(precision)
|
||||
|
||||
script translation
|
||||
on |λ|(recLang)
|
||||
set maybeTrans to keyValue(recLang, k)
|
||||
set strBrief to cond(maybeTrans is missing value, k, maybeTrans)
|
||||
|
||||
set recExpand to keyValue(recLang, "expansions")
|
||||
|
||||
if recExpand is not missing value then
|
||||
script expand
|
||||
on |λ|(c)
|
||||
set t to keyValue(recExpand, c)
|
||||
cond(t is not missing value, t, c)
|
||||
end |λ|
|
||||
end script
|
||||
set strName to (intercalate(cond(precision > 5, " ", ""), ¬
|
||||
map(expand, characters of strBrief)))
|
||||
toUpper(text item 1 of strName) & text items 2 thru -1 of strName
|
||||
else
|
||||
strBrief
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
map(translation, plstLangs)
|
||||
end pointNames
|
||||
|
||||
-- maxLen :: [String] -> Int
|
||||
on maxLen(xs)
|
||||
length of maximumBy(comparing(my |length|), xs)
|
||||
end maxLen
|
||||
|
||||
-- alignRight :: Int -> String -> String
|
||||
on alignRight(nWidth, x)
|
||||
justifyRight(nWidth, space, x)
|
||||
end alignRight
|
||||
|
||||
-- alignLeft :: Int -> String -> String
|
||||
on alignLeft(nWidth, x)
|
||||
justifyLeft(nWidth, space, x)
|
||||
end alignLeft
|
||||
|
||||
-- show :: asString => a -> Text
|
||||
on show(x)
|
||||
x as string
|
||||
end show
|
||||
|
||||
-- compassTable :: Int -> [Num] -> Maybe String
|
||||
on compassTable(precision, xs)
|
||||
if precision < 1 then
|
||||
missing value
|
||||
else
|
||||
set intPad to 2
|
||||
set rightAligned to curry(alignRight)
|
||||
set leftAligned to curry(alignLeft)
|
||||
set join to curry(my intercalate)
|
||||
|
||||
-- INDEX COLUMN
|
||||
set lstIndex to map(|λ|(precision) of curry(pointIndex), xs)
|
||||
set lstStrIndex to map(show, lstIndex)
|
||||
set nIndexWidth to maxLen(lstStrIndex)
|
||||
set colIndex to map(|λ|(nIndexWidth + intPad) of rightAligned, lstStrIndex)
|
||||
|
||||
-- ANGLES COLUMN
|
||||
script degreeFormat
|
||||
on |λ|(x)
|
||||
set {c, m} to splitOn(".", x as string)
|
||||
c & "." & (text 1 thru 2 of (m & "0")) & "°"
|
||||
end |λ|
|
||||
end script
|
||||
set lstAngles to map(degreeFormat, xs)
|
||||
set nAngleWidth to maxLen(lstAngles) + intPad
|
||||
set colAngles to map(|λ|(nAngleWidth) of rightAligned, lstAngles)
|
||||
|
||||
-- NAMES COLUMNS
|
||||
script precisionNames
|
||||
on |λ|(iBox)
|
||||
pointNames(precision, iBox)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set lstTrans to transpose(map(precisionNames, lstIndex))
|
||||
set lstTransWidths to map(maxLen, lstTrans)
|
||||
|
||||
script spacedNames
|
||||
on |λ|(lstLang, i)
|
||||
map(|λ|((item i of lstTransWidths) + 2) of leftAligned, lstLang)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set colsTrans to map(spacedNames, lstTrans)
|
||||
|
||||
-- TABLE
|
||||
intercalate(linefeed, ¬
|
||||
map(|λ|("") of join, ¬
|
||||
transpose({colIndex} & {colAngles} & ¬
|
||||
{replicate(length of lstIndex, " ")} & colsTrans)))
|
||||
end if
|
||||
end compassTable
|
||||
|
||||
|
||||
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
on run
|
||||
set xs to [0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, ¬
|
||||
84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, ¬
|
||||
185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, ¬
|
||||
270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, ¬
|
||||
354.38]
|
||||
|
||||
-- If we supply other precisions, like 4 or 6, (2^n -> 16 or 64 boxes)
|
||||
-- the bearings will be divided amongst smaller or larger numbers of boxes,
|
||||
-- either using name translations retrieved by the generic hash
|
||||
-- or using the keys of the hash itself (combined with any expansions)
|
||||
-- to substitute for missing names for very finely divided boxes.
|
||||
|
||||
compassTable(5, xs) -- // 2^5 -> 32 boxes
|
||||
end run
|
||||
|
||||
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
|
||||
-- comparing :: (a -> b) -> (a -> a -> Ordering)
|
||||
on comparing(f)
|
||||
set mf to mReturn(f)
|
||||
script
|
||||
on |λ|(a, b)
|
||||
set x to mf's |λ|(a)
|
||||
set y to mf's |λ|(b)
|
||||
if x < y then
|
||||
-1
|
||||
else
|
||||
if x > y then
|
||||
1
|
||||
else
|
||||
0
|
||||
end if
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
end comparing
|
||||
|
||||
-- cond :: Bool -> a -> a -> a
|
||||
on cond(bool, f, g)
|
||||
if bool then
|
||||
f
|
||||
else
|
||||
g
|
||||
end if
|
||||
end cond
|
||||
|
||||
-- curry :: (Script|Handler) -> Script
|
||||
on curry(f)
|
||||
script
|
||||
on |λ|(a)
|
||||
script
|
||||
on |λ|(b)
|
||||
|λ|(a, b) of mReturn(f)
|
||||
end |λ|
|
||||
end script
|
||||
end |λ|
|
||||
end script
|
||||
end curry
|
||||
|
||||
-- foldl :: (a -> b -> a) -> a -> [b] -> a
|
||||
on foldl(f, startValue, xs)
|
||||
tell mReturn(f)
|
||||
set v to startValue
|
||||
set lng to length of xs
|
||||
repeat with i from 1 to lng
|
||||
set v to |λ|(v, item i of xs, i, xs)
|
||||
end repeat
|
||||
return v
|
||||
end tell
|
||||
end foldl
|
||||
|
||||
-- intercalate :: Text -> [Text] -> Text
|
||||
on intercalate(strText, lstText)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, strText}
|
||||
set strJoined to lstText as text
|
||||
set my text item delimiters to dlm
|
||||
return strJoined
|
||||
end intercalate
|
||||
|
||||
-- justifyLeft :: Int -> Char -> Text -> Text
|
||||
on justifyLeft(N, cFiller, strText)
|
||||
if N > length of strText then
|
||||
text 1 thru N of (strText & replicate(N, cFiller))
|
||||
else
|
||||
strText
|
||||
end if
|
||||
end justifyLeft
|
||||
|
||||
-- justifyRight :: Int -> Char -> Text -> Text
|
||||
on justifyRight(N, cFiller, strText)
|
||||
if N > length of strText then
|
||||
text -N thru -1 of ((replicate(N, cFiller) as text) & strText)
|
||||
else
|
||||
strText
|
||||
end if
|
||||
end justifyRight
|
||||
|
||||
-- keyValue :: Record -> String -> Maybe String
|
||||
on keyValue(rec, strKey)
|
||||
set ca to current application
|
||||
set v to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey
|
||||
if v is not missing value then
|
||||
item 1 of ((ca's NSArray's arrayWithObject:v) as list)
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end keyValue
|
||||
|
||||
-- length :: [a] -> Int
|
||||
on |length|(xs)
|
||||
length of xs
|
||||
end |length|
|
||||
|
||||
-- map :: (a -> b) -> [a] -> [b]
|
||||
on map(f, xs)
|
||||
tell mReturn(f)
|
||||
set lng to length of xs
|
||||
set lst to {}
|
||||
repeat with i from 1 to lng
|
||||
set end of lst to |λ|(item i of xs, i, xs)
|
||||
end repeat
|
||||
return lst
|
||||
end tell
|
||||
end map
|
||||
|
||||
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
|
||||
on maximumBy(f, xs)
|
||||
set cmp to mReturn(f)
|
||||
script max
|
||||
on |λ|(a, b)
|
||||
if a is missing value or cmp's |λ|(a, b) < 0 then
|
||||
b
|
||||
else
|
||||
a
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(max, missing value, xs)
|
||||
end maximumBy
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
-- replicate :: Int -> a -> [a]
|
||||
on replicate(N, a)
|
||||
set out to {}
|
||||
if N < 1 then return out
|
||||
set dbl to {a}
|
||||
|
||||
repeat while (N > 1)
|
||||
if (N mod 2) > 0 then set out to out & dbl
|
||||
set N to (N div 2)
|
||||
set dbl to (dbl & dbl)
|
||||
end repeat
|
||||
return out & dbl
|
||||
end replicate
|
||||
|
||||
-- splitOn :: Text -> Text -> [Text]
|
||||
on splitOn(strDelim, strMain)
|
||||
set {dlm, my text item delimiters} to {my text item delimiters, strDelim}
|
||||
set xs to text items of strMain
|
||||
set my text item delimiters to dlm
|
||||
return xs
|
||||
end splitOn
|
||||
|
||||
-- transpose :: [[a]] -> [[a]]
|
||||
on transpose(xss)
|
||||
script column
|
||||
on |λ|(_, iCol)
|
||||
script row
|
||||
on |λ|(xs)
|
||||
item iCol of xs
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
map(row, xss)
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
map(column, item 1 of xss)
|
||||
end transpose
|
||||
|
||||
-- toLower :: String -> String
|
||||
on toLower(str)
|
||||
set ca to current application
|
||||
((ca's NSString's stringWithString:(str))'s ¬
|
||||
lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
|
||||
end toLower
|
||||
|
||||
-- toTitle :: String -> String
|
||||
on toTitle(str)
|
||||
set ca to current application
|
||||
((ca's NSString's stringWithString:(str))'s ¬
|
||||
capitalizedStringWithLocale:(ca's NSLocale's currentLocale())) as text
|
||||
end toTitle
|
||||
|
||||
-- toUpper :: String -> String
|
||||
on toUpper(str)
|
||||
set ca to current application
|
||||
((ca's NSString's stringWithString:(str))'s ¬
|
||||
uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
|
||||
end toUpper
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
on degreesToCompassPoint(degrees)
|
||||
set cardinals to {"north", "east", "south", "west"}
|
||||
set idx to ((degrees / 11.25) as integer) mod 32
|
||||
set qIdx to idx mod 8
|
||||
if (qIdx = 0) then return cardinals's item (idx div 8 + 1)
|
||||
set ns to cardinals's item (3 - (idx + 24) div 16 mod 2 * 2)
|
||||
set ew to cardinals's item ((idx div 16 + 1) * 2)
|
||||
if (idx mod 16 > 7) then set qIdx to 8 - qIdx
|
||||
if (qIdx = 1) then return ns & " by " & ew
|
||||
if (qIdx = 2) then return ns & "-" & ns & ew
|
||||
if (qIdx = 3) then return ns & ew & " by " & ns
|
||||
if (qIdx = 4) then return ns & ew
|
||||
if (qIdx = 5) then return ns & ew & " by " & ew
|
||||
if (qIdx = 6) then return ew & "-" & ns & ew
|
||||
return ew & " by " & ns -- qIdx = 7.
|
||||
end degreesToCompassPoint
|
||||
|
||||
on join(lst, delim)
|
||||
set astid to AppleScript's text item delimiters
|
||||
set AppleScript's text item delimiters to delim
|
||||
set txt to lst as text
|
||||
set AppleScript's text item delimiters to astid
|
||||
return txt
|
||||
end join
|
||||
|
||||
on task()
|
||||
set output to {"", "Index Compass point Degrees"}
|
||||
set inputs to {0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38, 101.25, 118.12, ¬
|
||||
118.13, 135.0, 151.87, 151.88, 168.75, 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, ¬
|
||||
253.12, 253.13, 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38}
|
||||
repeat with i from 1 to (count inputs)
|
||||
set degrees to inputs's item i
|
||||
set cpid to (degreesToCompassPoint(degrees))'s id
|
||||
set cpid's first item to (cpid's beginning) mod 32 + 64
|
||||
set compassPoint to string id cpid
|
||||
set degrees to degrees as text
|
||||
set entry to {text -2 thru -1 of (space & ((i - 1) mod 32 + 1)), ¬
|
||||
text 1 thru 18 of (compassPoint & " "), ¬
|
||||
text (offset of "." in degrees) thru end of (" " & degrees)}
|
||||
set end of output to join(entry, " ")
|
||||
end repeat
|
||||
|
||||
join(output, linefeed)
|
||||
end task
|
||||
|
||||
task()
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
"
|
||||
Index Compass point Degrees
|
||||
1 North 0.0
|
||||
2 North by east 16.87
|
||||
3 North-northeast 16.88
|
||||
4 Northeast by north 33.75
|
||||
5 Northeast 50.62
|
||||
6 Northeast by east 50.63
|
||||
7 East-northeast 67.5
|
||||
8 East by north 84.37
|
||||
9 East 84.38
|
||||
10 East by south 101.25
|
||||
11 East-southeast 118.12
|
||||
12 Southeast by east 118.13
|
||||
13 Southeast 135.0
|
||||
14 Southeast by south 151.87
|
||||
15 South-southeast 151.88
|
||||
16 South by east 168.75
|
||||
17 South 185.62
|
||||
18 South by west 185.63
|
||||
19 South-southwest 202.5
|
||||
20 Southwest by south 219.37
|
||||
21 Southwest 219.38
|
||||
22 Southwest by west 236.25
|
||||
23 West-southwest 253.12
|
||||
24 West by south 253.13
|
||||
25 West 270.0
|
||||
26 West by north 286.87
|
||||
27 West-northwest 286.88
|
||||
28 Northwest by west 303.75
|
||||
29 Northwest 320.62
|
||||
30 Northwest by north 320.63
|
||||
31 North-northwest 337.5
|
||||
32 North by west 354.37
|
||||
1 North 354.38"
|
||||
Loading…
Add table
Add a link
Reference in a new issue