RosettaCodeData/Task/Box-the-compass/Action-/box-the-compass.action
2023-07-01 13:44:08 -04:00

106 lines
2 KiB
Text

INCLUDE "D2:PRINTF.ACT" ;from the Action! Tool Kit
INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
DEFINE PTR="CARD"
PROC InitNames(PTR ARRAY names)
names(0)="N" names(1)="NbE"
names(2)="NNE" names(3)="NEbN"
names(4)="NE" names(5)="NEbE"
names(6)="ENE" names(7)="EbN"
names(8)="E" names(9)="EbS"
names(10)="ESE" names(11)="SEbE"
names(12)="SE" names(13)="SEbS"
names(14)="SSE" names(15)="SbE"
names(16)="S" names(17)="SbW"
names(18)="SSW" names(19)="SWbS"
names(20)="SW" names(21)="SWbW"
names(22)="WSW" names(23)="WbS"
names(24)="W" names(25)="WbN"
names(26)="WNW" names(27)="NWbW"
names(28)="NW" names(29)="NWbN"
names(30)="NNW" names(31)="NbW"
names(32)="N"
RETURN
PROC PrintIndex(BYTE i)
CHAR ARRAY s(5)
StrB(i,s)
PrintF("%2S",s)
RETURN
BYTE FUNC FindDot(CHAR ARRAY s)
BYTE i
FOR i=1 TO s(0)
DO
IF s(i)='. THEN
RETURN (i)
FI
OD
RETURN (0)
PROC PrintAngle(REAL POINTER a)
CHAR ARRAY s(10)
BYTE pos
StrR(a,s)
pos=FindDot(s)
IF pos=0 THEN
s(0)==+3
s(s(0)-2)='.
s(s(0)-1)='0
s(s(0)-0)='0
ELSEIF pos=s(0)-1 THEN
s(0)==+1
s(s(0)-0)='0
FI
PrintF("%6S",s)
RETURN
INT FUNC GetIndex(REAL POINTER a)
REAL r32,r360,r1,r2
IntToReal(32,r32)
IntToReal(360,r360)
RealMult(a,r32,r1)
RealDiv(r1,r360,r2)
RETURN (RealToInt(r2))
PROC Main()
DEFINE COUNT="33"
PTR ARRAY names(COUNT)
INT i,m,ind,x,y
REAL ri,r11_25,r5_62,rh,r1
Put(125) PutE() ;clear the screen
InitNames(names)
ValR("11.25",r11_25)
ValR("5.62",r5_62)
FOR i=0 TO 32
DO
IntToReal(i,ri)
RealMult(ri,r11_25,rh)
m=i MOD 3
IF m=1 THEN
RealAdd(rh,r5_62,r1)
RealAssign(r1,rh)
ELSEIF m=2 THEN
RealSub(rh,r5_62,r1)
RealAssign(r1,rh)
FI
ind=GetIndex(rh)
IF i<16 THEN
x=2 y=i+1
ELSE
x=20 y=i-15
FI
Position(x,y) PrintIndex(ind MOD (COUNT-1)+1)
x==+3
Position(x,y) Print(names(ind))
x==+5
Position(x,y) PrintAngle(rh)
OD
RETURN