Box the compass: Difference between revisions

Line 6,474:

=={{header|REXX}}==

This version does normalization of the (degree) heading and can also handle negative headings.

<syntaxhighlight lang="rexx">/*REXX program "boxes the compass" ~~[from~~ ~~degree~~ ~~(º)~~ ~~headings~~ ~~───►~~ a 32 ~~point~~ ~~set].~~ */

<syntaxhighlight lang="rexx">/*REXX program "boxes the compass" */

~~parse~~ ~~arg~~ $ ~~/*allow º headings to be specified.~~*/

/* [from degree (º) headings ---> a 32 point set]. */

Parse Arg degrees

if $='' then $= 0 16.87 16.88 33.75 50.62 50.63 67.5 84.37 84.38 101.25 118.12 118.13 ,

If degrees='' Then

⚫

135 151.87 151.88 168.75 185.62 185.63 202.5 ~~219.37 219.38 236.25~~ ,

~~253.12 253.13 270 286~~.87 ~~286~~.88 ~~303~~.75 ~~320~~.62 ~~320~~.63 ~~337~~.5 ~~354~~.37 ~~354~~.38

degrees=0 16.87 16.88 33.75 50.62 50.63 67.5 84.37 84.38 101.25,

⚫

118.12 118.13 135 151.87 151.88 168.75 185.62 185.63 202.5,

⚫

/* ~~[↑]~~ ~~use~~ ~~default~~, ~~they~~'re in ~~degrees~~*/

219.37 219.38 236.25 253.12 253.13 270 286.87 286.88 303.75,

⚫

~~@pts~~= 'n nbe n-ne nebn ne nebe e-ne ebn e ebs e-se sebe se sebs s-se sbe',

320.62 320.63 337.5 354.37 354.38

⚫

"s sbw s-sw swbs sw swbw w-sw wbs w wbn w-nw nwbw nw nwbn n-nw nbw"

⚫

names='n nbe n-ne nebn ne nebe e-ne ebn e ebs e-se sebe se sebs s-se sbe',

⚫

's sbw s-sw swbs sw swbw w-sw wbs w wbn w-nw nwbw nw nwbn n-nw nbw'

#= words(~~@pts~~) + 1 /*#: used for integer ÷ remainder ~~(//)~~*/

nn=words(names)+1 /* nn: used for integer ÷ remainder */

dirs= 'north south east west' /*define cardinal compass directions. */

dirs='north south east west' /* define cardinal compass directions*/

/* ~~[↓]~~ choose a glyph for degree (°).*/

/* choose a glyph for degree (°).*/

if 4=='f4'x ~~then~~ ~~degSym=~~ ~~"a1"x~~ /*is this system an EBCDIC system? */

If 4=='f4'x Then /* is this system an EBCDIC system*/

degsym='a1'x

else degSym= "a7"x /*'f8'x is the degree symbol: ° vs º */

Else

/*──────────────────────────── f8 vs a7*/

⚫

degsym='f8'x /* or degsym='a7'x */

say right(degSym'heading', 30) center("compass heading", 20)

~~say~~ right( '~~════════~~', 30) ~~copies~~( ~~"═"~~, 20)

Say right(degsym'heading',30) center('compass heading',20)

Say right('--------',30) copies('-',20)

⚫

~~pad=~~ ' ' ~~/*used to interject a blank for output.~~*/

do ~~j=1~~ ~~for~~ ~~words($);~~ x= ~~word($,~~ j) /*~~obtain~~ ~~one~~ of ~~the~~ ~~degree~~ ~~headings.~~ */

pad=' ' /* used to interject a blank for o */

Do i=1 To words(degrees)

⚫

~~say~~ right( format(x, , 2)~~degSym~~, 30-1) pad ~~boxHeading~~(x)

~~end~~ /*j*/

x=word(degrees,i) /* obtain one of the degree headings */

⚫

Say right(format(x,,2)degsym,30-1) pad boxheading(x)

exit /*stick a fork in it, we're all done. */

End

/*──────────────────────────────────────────────────────────────────────────────────────*/

⚫

Exit /* stick a fork in it, we're all done*/

boxHeading: y= arg(1)//360; if y<0 then y=360-y /*normalize heading within unit circle.*/

/*---------------------------------------------------------------------*/

⚫

z= word(~~@pts~~, trunc(max(1, (y/11.25 +1.5) // #))) /*~~convert~~ ~~degrees─►heading~~*/

boxheading:

do k=1 for words(dirs); d= word(dirs, k)

y=arg(1)//360

z= changestr( left(d, 1), z, d)

If y<0 Then

end /*k*/ /* [↑] old, haystack, new*/

~~return changestr('b', z, " by ")~~ /*~~expand~~ ~~"b"~~ ~~───►~~ " by ".*/~~</syntaxhighlight>~~

y=360-y /* normalize heading within unit circle */

⚫

z=word(names,trunc(max(1,(y/11.25+1.5)//nn))) /* degrees->heading */

/* n e s w are now replaced by north east south west, respectively */

Do k=1 To words(dirs)

d=word(dirs,k)

z=changestr(left(d,1),z,d)

End

Return changestr('b',z,' by ') /* expand 'b' ---? ' by '. */</syntaxhighlight>

Some older REXXes don't have a   '''changestr'''   BIF,   so one is included here   ──►   [[CHANGESTR.REX]].

'''output'''

<pre>

ºheading compass heading

Line 6,543:

Line 6,552:

354.38º north

</pre>

=={{header|Ring}}==