REAL TriSolve92 0.1alpha

[Prev][Next][Index][Thread]

REAL TriSolve92 0.1alpha

here... sorry about that

**TI92**mainTrisolv v0.1b by J.P. McClain      ;()RtrisolveuZ()
Prgm


Define variables as local
local rd:4rd Rounded Digits
local triver:"TriSolve v0.1"triver
local nosoluts:1nosoluts
local tail:""tail
local solnindx:1solnindx
local ga1:local ga2:local ga3
local gs1:local gs2:local gs3
local ga12:local ga22:local ga32
local gs12:local gs22:local gs32
local sgiven:local agiven
local aa:local ab:local ac
local sa:local sb:local sc
local aa2:local ab2:local ac2
local sa2:local sb2:local sc2
local origin
local oldmode

SetMode("Angle","DEGREE")oldmode


Define needed Function: Boolean test
local bool()
Define bool(bo)=Func
 If bo=true Then
   Return 1
 Else
   Return 0
 EndIf
EndFunc

Start Main Program
Dialog
 Title triver
 Text " Welcome to "&triver
 Text ""
 Text "      by J.P. McClain"
 Text "    JPMcClain@colint.com"
EndDlog
If ok1:Goto bye

Dialog
 Title triver
 Text "Enter Given Information:"
 Request " a",sa
 Request "A",aa
 Request " b",sb
 Request "B",ab
 Request " c",sc
 Request "C",ac
EndDlog
If ok1:Goto bye

bool(sa"")+bool(sb"")+bool(sc"")sgiven
bool(aa"")+bool(ab"")+bool(ac"")agiven


If sgiven=3 and agiven=0 Then
 Goto sss
ElseIf sgiven=2 and agiven=1 Then
 Goto ass
ElseIf sgiven=1 and agiven=2 Then
 Goto aas
Else
 0nosoluts
 Goto report
EndIf



Lbl sss
expr(sa)sa
expr(sb)sb
expr(sc)sc
cos((sb^2+sc^2-sa^2)/(2*sb*sc))aa
cos((sa^2+sc^2-sb^2)/(2*sa*sc))ab
cos((sa^2+sb^2-sc^2)/(2*sa*sb))ac
If imag(aa)0 or imag(ab)0 or imag(ac)0 Then
 0nosoluts
Else
 1nosoluts
EndIf
Goto report



Lbl ass
If AA"" Then
  If SA"" and SB"" Then
    aaga1:sags1:sbgs2
    "ASSA1"origin:Goto DOASS
    Lbl ASSA1
    ga1aa:ga2ab:ga3ac
    gs1sa:gs2sb:gs3sc
    If nosoluts=2 Then
      ga12aa2:ga22ab2:ga32ac2
      gs12sa2:gs22sb2:gs32sc2     
    EndIf
  ElseIf SA"" and SC"" Then
    aaga1:sags1:scgs2
    "ASSA2"origin:Goto DOASS
    Lbl ASSA2
    ga1aa:ga2ac:ga3ab
    gs1sa:gs2sc:gs3sb
    If nosoluts=2 Then
      ga12aa2:ga22ac2:ga32ab2
      gs1sa2:gs22sc2:gs32sb2
    EndIf
  Else
    aaga3:sbgs1:scgs2
    "ASSA3"origin:Goto DOSAS
    Lbl ASSA3
    gs3sa:ga1ab:ga2ac
    ga3aa:gs1sb:gs2sc
  EndIf
ElseIf AB"" Then
  If SA"" and SB"" Then
    abga1:sags2:sbgs1
    "ASSB1"origin:Goto DOASS
    Lbl ASSB1
    ga1ab:ga2aa:ga3ac
    gs1sb:gs2sa:gs3sc
    If nosoluts=2 Then
      ga12ab2:ga22aa2:ga32ac2
      gs12sb2:gs22sa2:gs32sc2
    EndIf
  ElseIf SA"" and SC"" Then
    sags1:scgs2:abga3
    "ASSB2"origin:Goto DOSAS
    LbL ASSB2
    ga1aa:ga2ac:gs3sb
    gs1sa:gs2sc:ga3ab
  Else
    abga1:sbgs1:scgs2
    "ASSB3"origin:Goto DOASS
    Lbl ASSB3
    ga1ab:ga2ac:ga3aa
    gs1sb:gs2sc:gs3sa
    If nosoluts=2 Then
      ga12ab2:ga22ac2:ga32aa2
      gs12sb2:gs22sc2:gs32sa2
    EndIf
  EndIf
Else
  If SA"" and SB"" Then
    sags1:sbgs2:acga3
    "ASSC1"origin:Goto DOSAS
    Lbl ASSC1
    ga1aa:ga2ab:gs3sc
    gs1sa:gs2sb:ga3ac
  ElseIf SA"" and SC"" Then
    acga1:scgs1:sags2
    "ASSC2"origin:Goto DOASS
    Lbl ASSC2
    ga1ac:ga2aa:ga3ab
    gs1sc:gs2sa:gs3sb
    If nosoluts=2 Then
      ga12ac2:ga22aa2:ga32ab2
      gs12sc2:gs22sa2:gs32sb2
    EndIf  
  Else
    acga1:scgs1:sbgs2
    "ASSC3"origin:Goto DOASS
    Lbl ASSC3
    ga1ac:ga2ab:ga3aa
    gs1sc:gs2sb:gs3sa
    If nosoluts=2 Then
      ga12ac2:ga22ab2:ga32aa2
      gs12sc2:gs22sb2:gs32sa2
    EndIf
  EndIf
EndIf
Goto Report


Lbl aas
1nosoluts
If aa="" Then
 expr(ab)ab:expr(ac)ac
 180-ab-acaa
ElseIf ab="" Then
 expr(aa)aa:expr(ac)ac
 180-aa-acab
Else
 expr(ab)ab:expr(aa)aa
 180-ab-aaac
EndIf
If sa"" Then
 expr(sa)sa
 sa*sin(ab)/(sin(aa))sb
 sa*sin(ac)/(sin(aa))sc
ElseIf sb"" Then
 expr(sb)sb
 sb*sin(aa)/(sin(ab))sa
 sb*sin(ac)/(sin(ab))sc
Else
 expr(sc)sc
 sc*sin(ab)/(sin(ac))sb
 sc*sin(aa)/(sin(ac))sa
EndIf
Goto report


Lbl DOASS
expr(ga1)ga1:expr(gs1)gs1:expr(gs2)gs2
ga1ga12:gs1gs12:gs2gs22
sin(gs2*sin(ga1)/gs1)ga22
180-ga1-ga22ga32
gs1*sin(ga32)/sin(ga1)gs32
180-ga22ga2
if ga1+ga2180 then
 1nosoluts
 ga12ga1:ga22ga2:ga32ga3
 gs12gs1:gs22gs2:gs32gs3
Else
 2nosoluts
 180-ga1-ga2ga3
 gs1*sin(ga3)/sin(ga1)gs3
EndIf
Goto #origin


Lbl DOSAS
1nosoluts
expr(gs1)gs1:expr(gs2)gs2:expr(ga3)ga3
(gs1^2+gs2^2-2gs1*gs2*cos(ga3))gs3
cos((gs2^2+gs3^2-gs1^2)/(2*gs2*gs3))ga1
180-ga3-ga1ga2
Goto #origin



Lbl report
If imag(aa)0 or imag(ab)0 or imag(ac)0 or imag(sa)0 or imag(sb)0 or imag(sc)0 or aa=0 or aa=180 or ab=0 or ab=180 or ac=0 or ac=180 Then
 0nosoluts
EndIf

If nosoluts=0 Then
 Dialog
  Title triver
  Text "    Solution Triangle:"
  Text ""
  Text "        NO SOLUTION"
  Text "            or"
  Text "    INFINITE SOLUTIONS"
  Text ""
 EndDlog
 Goto bye
EndIf


Lbl again
If nosoluts=2 Then
 If solnindx=1 Then
  " [1/2]"tail
 Else
  " [2/2]"tail
  aa2aa:ab2ab:ac2ac
  sa2sa:sb2sb:sc2sc
 EndIf
EndIf

If rd1 Then
round(aa,rd)aa:round(ab,rd)ab:round(ac,rd)ac
round(sa,rd)sa:round(sb,rd)sb:round(sc,rd)sc
EndIf


string(aa)aa:string(ab)ab:string(ac)ac
string(sa)sa:string(sb)sb:string(sc)sc

Dialog
 Title triver
 Text "Solution Triangle"&tail&":"
 Text ""
 Text " a= "&sa
 Text "A= "&aa&""
 Text " b= "&sb
 Text "B= "&ab&""
 Text " c= "&sc
 Text "C= "&ac&""
EndDlog

If nosoluts=2 and solnindx=1 Then
 2solnindx
Goto again
EndIf


Lbl bye
SetMode("Angle",oldmode)
EndPrgm0