home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 120 / 120.d81 / trigon (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1994-01-01  |  17.4 KB  |  514 lines
  1. 30 poke53280,0:poke53281,0:gosub60000:poke 198,0
  2. 40 clr:poke 788,52
  3. 42 dim cr(1,2),cr$(1,2),cu$(4),fr(1,1,2),fr$(1,1,2),k(1),ms$(20),rt(2)
  4. 50 dim a,a0,a1,a2,ad,a$,b,b0,b1,b2,b$
  5. 60 dim c,c0,c1,c2,cp,cs,cu,cv,c0$,c1$,c2$,c3$,c4$,c5$,cu$
  6. 70 dim d,db,dp,ds,dv,em,ex,fe,fq,ft,h,h0,h1,h2,h$
  7. 80 dim j,k,kc$,l,m,mc,mc$,ms,n,ns,pr,pw,r0,r1,r2,rs
  8. 90 dim s,so,sc$,sr$,t0,t1,ta,tb,tc,uc,v0,v1,v2,wd$,x,xp,xs,y,yp,ys
  9. 110 dv=peek(186):if dv<8 then dv=8
  10. 130 sys57812"trigfont",dv,0:poke780,0:poke781,0:poke782,232:sys65493
  11. 140 sys57812"trig.obj",dv,0:poke780,0:poke781,0:poke782,192:sys65493
  12. 150 ad=49152:sysad+15,0:sysad+21,1:poke53265,peek(53265)and191
  13. 152 print"[147]"chr$(142)
  14. 153 poke53280,6:poke53281,14:poke53282,0:poke53283,1:poke53284,6
  15. 160 gosub 4720:sr$=chr$(20)+"1234567890.[145][157][133][147][134]q[209]h[200]p[208]"+chr$(13)
  16. 170 cu$(1)="( [196][196] )":cu$(2)="([196][205][211] )":cu$(3)="([210][193][196] )":cu$(4)="([199][210][193][196])"
  17. 180 wd$="":x=0:y=0:sc$="              [157][157][157][157][157][157][157][157][157][157][157][157][157][157]":cu=1
  18. 190 kc$="               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]":poke53269,0:poke650,128:db=0
  19. 200 c0$="[158]":c1$="[129]":c2$="[156]":c3$="":c4$=""
  20. 210 forj=0to1:fork=0to2:poke214,2*k+13:poke211,18*j+5:sys58732:printc0$sc$
  21. 220 next:next:gosub 1980:poke214,13:poke211,5:sys58732:sysad+9,0
  22. 240 rem *** main input loop ***
  23. 250 printchr$(142);: gosub 3930:ms=10:gosub 3880
  24. 260 ft=1
  25. 270 on ft gosub 550,530
  26. 280 for j=1 to 50
  27. 290 get a$:if a$="" then next:ft=1-(ft=1):goto 270
  28. 300 j=50:next
  29. 310 for j=1tolen(sr$):ifmid$(sr$,j,1)=a$then uc=j:j=len(sr$):next:goto 330
  30. 320 next:mc=1:ms=13:gosub3880:goto260
  31. 330 gosub 530:ifmcthenms=0:gosub3880:mc=0
  32. 340 on uc goto 420,370,370,370,370,370,370,370,370,370,370,380
  33. 350 on uc-12 goto 390,390,390,390,400,400,400,400,400,400,410,410,440,440,430
  34. 360 goto 270
  35. 370 gosub 860:goto 260:rem numbers
  36. 380 gosub 890:goto 260:rem dec point
  37. 390 gosub 960:goto 260:rem cursors
  38. 400 gosub 1890:goto 260:rem fkeys
  39. 410 gosub 4270:goto 260:rem help
  40. 420 gosub 920:goto 260:rem delete
  41. 430 gosub 1050:goto 260:rem return
  42. 440 gosub 1390:goto 260:rem printer
  43. 450 rem *** end program ***
  44. 460 poke 788,49:sysad+18,12,1,8
  45. 470 goto40000
  46. 520 sysad+18,12,1,8:print"[147]";:end
  47. 530 a=40*peek(214)+peek(211)+256*peek(648)
  48. 540 poke a,peek(a)and127:return
  49. 550 a=40*peek(214)+peek(211)+256*peek(648)
  50. 560 poke a,peek(a)or128:return
  51. 570 if len(wd$) then return
  52. 580 printc0$sc$;:return
  53. 590 rem *** fe sound ***
  54. 600 s=54272:sysad+24
  55. 610 pokes+1,08:pokes+4,32:pokes+6,240:pokes+24,15:poke s+4,33
  56. 620 for j=1 to 1000:next:pokes+4,16
  57. 630 sysad+24:return
  58. 640 s=54272:sysad+24
  59. 650 pokes+1,fq:pokes+3,pw:pokes+4,64:pokes+5,11:pokes+24,15:pokes+4,65:return
  60. 660 rem *** title screen ***
  61. 670 gosub60000:poke53280,6:poke53281,14:poke53282,0:poke53283,1:poke53284,6
  62. 680 poke 53265,peek(53265)or 64
  63. 690 tb=7
  64. 850 return
  65. 860 rem *** numerals ***
  66. 870 if (len(wd$)-dp)>=9 then return
  67. 880 gosub 570:printa$;:wd$=wd$+a$:return
  68. 890 rem *** decimal point ***
  69. 900 if dp then return
  70. 910 gosub 570:dp=1:printa$;:wd$=wd$+a$:return
  71. 920 rem *** delete ***
  72. 930 if len(wd$)=0 then return
  73. 940 if right$(wd$,1)="." then dp=0
  74. 950 wd$=left$(wd$,len(wd$)-1):print" [157][157] [157]";:return
  75. 960 rem *** cursors ***
  76. 970 poke214,2*y+13:poke211,18*x+5:sys58732:printc0$sc$cr$(x,y);
  77. 980 if a$="" and y<2 then y=y+1:goto 1020
  78. 990 if a$="[145]" and y>0 then y=y-1:goto 1020
  79. 1000 if a$="" and x=0 then x=1:goto 1020
  80. 1010 if a$="[157]" and x=1 then x=0
  81. 1020 poke 214,2*y+13:poke 211,18*x+5:sys 58732:
  82. 1030 wd$="":dp=0:return
  83. 1040 rem *** return ***
  84. 1050 gosub 530:if wd$="" then return
  85. 1060 if val(wd$)=0 then cr$(x,y)="":goto 1130
  86. 1070 if val(cr$(x,y)) then 1120
  87. 1080 a=sgn(val(cr$(1,0)))+sgn(val(cr$(1,1)))+sgn(val(cr$(1,2)))
  88. 1090 if x=1 and a>=2 then 1130
  89. 1100 b=sgn(val(cr$(0,0)))+sgn(val(cr$(0,1)))+sgn(val(cr$(0,2)))
  90. 1110 if a+b>=3 then 1130
  91. 1120 cr$(x,y)=wd$
  92. 1130 poke 214,2*y+13:poke211,18*x+5:sys58732:wd$="":dp=0
  93. 1140 printsc$cr$(x,y):poke 214,2*y+13:poke211,18*x+5:sys58732:return
  94. 1150 rem *** f(a0,b0,c0)=a1 ***
  95. 1160 if b0*c0=0 then em=15:goto 3290
  96. 1170 a1=b0*b0+c0*c0-a0*a0
  97. 1180 a1=a1/(2*b0*c0)
  98. 1190 if a1=0 then a1=(NULL)/2:return
  99. 1200 if a1>=1 then a1=0:return
  100. 1210 if a1<=-1 then a1=(NULL):return
  101. 1220 a1=atn(sqr(1-a1*a1)/a1)
  102. 1230 if a1<0 then a1=(NULL)+a1
  103. 1240 return
  104. 1250 rem *** f(a1,b0,c0)=a0 ***
  105. 1260 a0=b0*b0+c0*c0-2*b0*c0*cos(a1)
  106. 1270 if a0<0 then em=16:goto 3290
  107. 1280 a0=sqr(a0):return
  108. 1290 rem *** f(a1,b1,b0)=a0
  109. 1300 if sin(b1)=0 then em=15:goto 3290
  110. 1310 a0=b0*sin(a1)/sin(b1)
  111. 1320 return
  112. 1330 rem *** f(b0,b1,a0)=a1
  113. 1340 if b0=0 then em=15:goto 3290
  114. 1350 a1=a0*sin(b1)/b0
  115. 1360 if a1>=1 then a1=(NULL)/2:return
  116. 1370 if a1<0 then a1=0:return
  117. 1380 a1=atn(a1/sqr(1-a1*a1)):return
  118. 1390 rem *** print ***
  119. 1400 if so=0 then return
  120. 1410 ms=14:gosub 3880:mc=1
  121. 1420 sysad+9,3:xp=peek(211):yp=peek(214):cp=peek(646)
  122. 1430 poke214,11:poke211,0:sys58732:tb=11
  123. 1440 printtab(tb)"[158]                  [146]"
  124. 1450 printtab(tb)"  [195][200][207][207][211][197] [196][197][214][201][195][197]   "
  125. 1460 printtab(tb)"                  [146]"
  126. 1470 printtab(tb)" [146][159] [208]rinter#4      [158] "
  127. 1480 printtab(tb)" [146][159] [208]rinter#5      [158] "
  128. 1490 printtab(tb)" [146][159] [208]rinter#6      [158] "
  129. 1500 printtab(tb)" [146][159] [208]rinter#7      [158] "
  130. 1510 printtab(tb)"                  [146]"
  131. 1520 printtab(tb)" [195][210][211][210]/[210][197][212][213][210][206]/[211][212][207][208] "
  132. 1530 printtab(tb)"                  [146]"
  133. 1540 poke 198,0:sysad+27,12,14,16,4:pr=peek(780)
  134. 1550 pr=pr+3:if pr=3 then 1880
  135. 1560 sysad+3:sysad+30,0,39,0,7,160,12,0:poke53272,(peek(53272)and240)or10
  136. 1570 sysad+18,0,1,0:sysad+30,1,38,11,23,32,6,0:poke214,12:poke211,0:sys58732
  137. 1580 ms=14:gosub 3880
  138. 1590 printc3$"[211]et-up printer#"pr"and press any key,"
  139. 1600 print"or [209][146] to quit.":poke 198,0
  140. 1610 get a$:if a$="" then 1610
  141. 1620 if a$="q" or a$="[209]" then 1880
  142. 1630 open 15,pr,15:close 15:if st=0 then 1660
  143. 1640 printc1$"[208]rinter not detected!":sysad+33,32768
  144. 1650 ms=17:gosub 3880:forj=1to2000:next:goto1570
  145. 1660 print"[208]rinting...":ta=18:tb=40:sysad+36
  146. 1670 open pr,pr,7:cmd pr
  147. 1680 print"   [211][201][196][197][211]             [193][206][199][204][197][211] "cu$(cv);:sysad+42,40
  148. 1690 if so=2 then print"   [211][201][196][197][211]             [193][206][199][204][197][211] "cu$(cv);
  149. 1700 a=0:b=0:print:print"a= "fr$(a,0,b);:sysad+42,ta:print"[193]= ";:gosub 5060:a=1
  150. 1710 sysad+42,tb
  151. 1720 if so=2 then print"a= "fr$(a,0,b);:sysad+42,ta+tb:print"[193]= ";:gosub 5060
  152. 1730 a=0:b=1:print:print"b= "fr$(a,0,b);:sysad+42,ta:print"[194]= ";:gosub 5060:a=1
  153. 1740 sysad+42,tb
  154. 1750 if so=2 then print"b= "fr$(a,0,b);:sysad+42,ta+tb:print"[194]= ";:gosub 5060
  155. 1760 a=0:b=2:print:print"c= "fr$(a,0,b);:sysad+42,ta:print"[195]= ";:gosub 5060:a=1
  156. 1770 sysad+42,tb
  157. 1780 if so=2 then print"c= "fr$(a,0,b);:sysad+42,ta+tb:print"[195]= ";:gosub 5060
  158. 1790 a=0:print:print"   [193]rea=";:gosub 5130:sysad+42,tb:a=1
  159. 1800 if so=2 then print"   [193]rea=";:gosub 5130
  160. 1810 a=0:b=0:print:print"ha=";:gosub5150:sysad+42,tb:a=1
  161. 1820 if so=2 then print"ha=";:gosub 5150
  162. 1830 a=0:b=1:print:print"hb=";:gosub5150:sysad+42,tb:a=1
  163. 1840 if so=2 then print"hb=";:gosub 5150
  164. 1850 a=0:b=2:print:print"hc=";:gosub5150:sysad+42,tb:a=1
  165. 1860 if so=2 then print"hc=";:gosub 5150
  166. 1870 print#pr:close pr
  167. 1880 sysad+39:sysad:sysad+12,3:poke214,yp:poke211,xp:sys58732:poke646,cp:return
  168. 1890 rem *** function keys ***
  169. 1900 on uc-16 goto 1920,1930,1960,2010,2010,2010
  170. 1910 return
  171. 1920 gosub 2100:return
  172. 1930 for n=0to2:for m=0to1
  173. 1940 cr$(m,n)="":next:next:sysad+12,0:wd$="":dp=0
  174. 1950 poke214,13:poke211,5:sys58732:x=0:y=0:ms=0:gosub 1980:goto 3880
  175. 1960 rem *** circular units ***
  176. 1970 cu=cu+1:if cu=5 then cu=1
  177. 1980 j=peek(214):k=peek(211)
  178. 1990 poke214,11:poke 211,30:sys58732:printc2$cu$(cu)c0$
  179. 2000 poke214,j:poke211,k:sys58732:return
  180. 2010 rem *** end program ***
  181. 2020 ms=5:t0=150:t1=50:gosub3970
  182. 2030 if a$<>"y" and a$<>"[217]" then 2090
  183. 2040 sysad+3:poke56578,peek(56578)or3
  184. 2050 poke 56576,(peek(56576)and252)or3
  185. 2060 poke53272,(peek(53272)and15)or16
  186. 2070 poke53272,(peek(53272)and240)or4
  187. 2080 poke 648,4:sysad+21,0:goto 450
  188. 2090 ms=0:goto 3880
  189. 2100 rem *** solve the triangle ***
  190. 2110 poke 198,0:ds=0:rs=0
  191. 2120 ms=11:gosub 3880:wd$="":dp=0
  192. 2130 for n=0 to 1:for m=0 to 2
  193. 2140 cr(n,m)=val(cr$(n,m)):next:next
  194. 2150 gosub 3040:ifcr(1,0)+cr(1,1)+cr(1,2)>=(NULL) then 3270
  195. 2160 if cr(0,0)*cr(0,1)*cr(0,2)=0 then 2200
  196. 2170 if cr(0,0)>=cr(0,1)+cr(0,2) then 3270
  197. 2180 if cr(0,1)>=cr(0,0)+cr(0,2) then 3270
  198. 2190 if cr(0,2)>=cr(0,0)+cr(0,1) then 3270
  199. 2200 ns=0:fe=0:rt(0)=0:rt(1)=1:rt(2)=2
  200. 2210 gosub 2280:if ns then return
  201. 2220 rt(0)=1:rt(1)=2:rt(2)=0
  202. 2230 gosub 2280:if ns then return
  203. 2240 rt(0)=2:rt(1)=0:rt(2)=1
  204. 2250 gosub 2280:if ns then return
  205. 2260 ifcr(0,0)=0 and cr(0,1)=0 and cr(0,2)=0 then ms=12:mc=1:goto 3880
  206. 2270 ms=3:mc=1:gosub 3880:fq=255:pw=10:goto 640
  207. 2280 rem *** sss ***
  208. 2290 if rt(0) then 2370
  209. 2300 if cr(0,rt(0))*cr(0,rt(1))*cr(0,rt(2))=0 then 2370
  210. 2310 a0=cr(0,rt(0)):b0=cr(0,rt(1)):c0=cr(0,rt(2)):gosub1150:cr(1,rt(0))=a1
  211. 2320 if fe then return
  212. 2330 a0=cr(0,rt(1)):b0=cr(0,rt(2)):c0=cr(0,rt(0)):gosub1150:cr(1,rt(1))=a1
  213. 2340 if fe then return
  214. 2350 cr(1,rt(2))=(NULL)-cr(1,rt(0))-cr(1,rt(1))
  215. 2360 gosub 3330:return
  216. 2370 rem *** sas ***
  217. 2380 if cr(0,rt(0))*cr(1,rt(1))*cr(0,rt(2))=0 then 2450
  218. 2390 b0=cr(0,rt(0)):c0=cr(0,rt(2)):a1=cr(1,rt(1)):gosub 1250:cr(0,rt(1))=a0
  219. 2400 if fe then return
  220. 2410 a0=cr(0,rt(0)):b0=cr(0,rt(1)):c0=cr(0,rt(2)):gosub 1150:cr(1,rt(0))=a1
  221. 2420 if fe then return
  222. 2430 cr(1,rt(2))=(NULL)-cr(1,rt(0))-cr(1,rt(1))
  223. 2440 gosub 3330:return
  224. 2450 rem *** asa ***
  225. 2460 if cr(1,rt(0))*cr(0,rt(1))*cr(1,rt(2))=0 then 2530
  226. 2470 cr(1,rt(1))=(NULL)-cr(1,rt(0))-cr(1,rt(2))
  227. 2480 a1=cr(1,rt(0)):b1=cr(1,rt(1)):b0=cr(0,rt(1)):gosub 1290:cr(0,rt(0))=a0
  228. 2490 if fe then return
  229. 2500 a1=cr(1,rt(2)):b1=cr(1,rt(1)):b0=cr(0,rt(1)):gosub 1290:cr(0,rt(2))=a0
  230. 2510 if fe then return
  231. 2520 gosub 3330:return
  232. 2530 rem *** aas,saa ***
  233. 2540 r0=0:r1=1:r2=2:gosub 2570:if ns then return
  234. 2550 r0=2:r1=1:r2=0:gosub 2570:if ns then return
  235. 2560 goto 2640
  236. 2570 if cr(1,rt(r0))*cr(1,rt(r1))*cr(0,rt(r0))=0 then return
  237. 2580 cr(1,rt(r2))=(NULL)-cr(1,rt(r0))-cr(1,rt(r1))
  238. 2590 a1=cr(1,rt(r1)):b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):gosub1290:cr(0,rt(r1))=a0
  239. 2600 if fe then return
  240. 2610 a1=cr(1,rt(r2)):b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):gosub1290:cr(0,rt(r2))=a0
  241. 2620 if fe then return
  242. 2630 gosub 3330:return
  243. 2640 rem *** ssa,ass ***
  244. 2650 r0=0:r1=1:r2=2:gosub 2680:if ns then return
  245. 2660 r0=2:r1=1:r2=0:gosub 2680:return
  246. 2670 rem
  247. 2680 if cr(0,rt(r0))*cr(0,rt(r1))*cr(1,rt(r0))=0 then return
  248. 2690 if cr(0,rt(r0))>cr(0,rt(r1)) then 2770:rem 1 solution
  249. 2700 if (cr(0,rt(r0))=cr(0,rt(r1)))and(cr(1,rt(r0)))>=(NULL)/2thenreturn:rem no sol.
  250. 2710 if cr(0,rt(r0))=cr(0,rt(r1))andcr(1,rt(r0))<(NULL)/2 then 2770:rem 1 sol.
  251. 2720 if abs(cr(0,rt(r0))-cr(0,rt(r1))*sin(cr(1,rt(r0))))>5e-8 then 2740
  252. 2730 cr(1,rt(r1))=(NULL)/2:goto 2800
  253. 2740 ifcr(0,rt(r0))>cr(0,rt(r1))*sin(cr(1,rt(r0))) then 2840:rem 2 solution
  254. 2750 if cr(0,rt(r0))<cr(0,rt(r1))*sin(cr(1,rt(r0))) then return
  255. 2760 return
  256. 2770 rem *** one solution ***
  257. 2780 b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):a0=cr(0,rt(r1)):gosub1330:cr(1,rt(r1))=a1
  258. 2790 if fe then return
  259. 2800 cr(1,rt(r2))=(NULL)-cr(1,rt(r0))-cr(1,rt(r1))
  260. 2810 a1=cr(1,rt(r2)):b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):gosub1290:cr(0,rt(r2))=a0
  261. 2820 if fe then return
  262. 2830 gosub 3330:return
  263. 2840 rem *** two solutions ***
  264. 2850 b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):a0=cr(0,rt(r1)):gosub1330:cr(1,rt(r1))=a1
  265. 2860 if fe then return
  266. 2870 cr(1,rt(r2))=(NULL)-cr(1,rt(r0))-cr(1,rt(r1))
  267. 2880 a1=cr(1,rt(r2)):b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):gosub1290:cr(0,rt(r2))=a0
  268. 2890 if fe then return
  269. 2900 ds=1:rs=0:gosub 3330:if fe then return
  270. 2910 cr(1,rt(r1))=(NULL)-cr(1,rt(r1))
  271. 2920 cr(1,rt(r2))=(NULL)-cr(1,rt(r0))-cr(1,rt(r1))
  272. 2930 a1=cr(1,rt(r2)):b1=cr(1,rt(r0)):b0=cr(0,rt(r0)):gosub1290:cr(0,rt(r2))=a0
  273. 2940 if fe then return
  274. 2950 rs=1:gosub 3330:if fe then return
  275. 2960 ms=7:gosub 3880:poke 198,0
  276. 2970 get a$:if a$="" then 2970
  277. 2980 ms=1:gosub 3880:rs=0:gosub 3520:poke 198,0
  278. 2990 get a$:if a$="" then 2990
  279. 3000 ms=2:gosub 3880:rs=1:gosub 3520:poke 198,0
  280. 3010 get a$:if a$="" then 3010
  281. 3020 if a$=" " then 2980
  282. 3030 fs=0:ds=0:ns=1:poke214,2*y+13:poke211,18*x+5:sys58732:mc=1:ms=0:goto 3880
  283. 3040 rem *** convert to radians ***
  284. 3050 if cu=3 then return
  285. 3060 if cu=1 then goto 3230
  286. 3070 if cu=2 then gosub 3120:goto 3230
  287. 3080 rem *** grads ==> rad ***
  288. 3090 for n=0 to 2
  289. 3100 cr(1,n)=(NULL)*cr(1,n)/200
  290. 3110 next:return
  291. 3120 rem *** dms ==> dd ***
  292. 3130 for n=0 to 2:s=0
  293. 3140 for j=1 to len(cr$(1,n))
  294. 3150 if mid$(cr$(1,n),j,1)="." then s=j:j=len(cr$(1,n)):next:goto 3170
  295. 3160 next:cr(1,n)=val(cr$(1,n)):next:return
  296. 3170 a=val(mid$(cr$(1,n),1,s))
  297. 3180 b=val(mid$(cr$(1,n),s+1,2))*(10+9*(len(mid$(cr$(1,n),s+1,2))<>1))
  298. 3190 c=val(mid$(cr$(1,n),s+3,2))*(10+9*(len(mid$(cr$(1,n),s+3,2))<>1))
  299. 3200 d=val(mid$(cr$(1,n),s+5,2))*(10+9*(len(mid$(cr$(1,n),s+5,2))<>1))
  300. 3210 cr(1,n)=a+b/60+c/3600+d/360000
  301. 3220 next:return
  302. 3230 rem *** dd ==> rad ***
  303. 3240 for n=0 to 2
  304. 3250 cr(1,n)=(NULL)*cr(1,n)/180
  305. 3260 next:return
  306. 3270 rem *** error ***
  307. 3280 fq=2:pw=8:gosub 640:t0=150:t1=50:ms=6:mc=1:goto 3970
  308. 3290 rem *** fatal error ***
  309. 3300 t0=150:t1=50:fe=1:ns=1:ms=9:mc=1:gosub 3880
  310. 3310 gosub 590:gosub 3970:ms=em:gosub 3880
  311. 3320 return
  312. 3330 rem *** display answers ***
  313. 3340 gosub 3710:if fe then return
  314. 3350 if ds=0 then so=1
  315. 3355 cv=cu:if ds and rs then so=2
  316. 3360 ns=1:for n=0 to 2
  317. 3370 m=0:fr(rs,m,n)=cr(m,n):gosub 3640
  318. 3380 m=1:if cu=1 or cu=2 then fr(rs,m,n)=180*cr(m,n)/(NULL)
  319. 3390 if cu=1 then gosub 3640:goto 3510
  320. 3400 if cu<>2 then 3490
  321. 3410 fr(rs,m,n)=fr(rs,m,n)+.000001
  322. 3420 a=int(fr(rs,m,n)):b=60*(fr(rs,m,n)-a)
  323. 3430 a$=str$(a):a$=right$(a$,len(a$)-1)
  324. 3440 a=int(b):b=60*(b-a)
  325. 3450 b$=str$(a):b$=right$(b$,len(b$)-1)
  326. 3460 b=int(100*b)/100
  327. 3470 c$=str$(b):c$=right$(c$,len(c$)-1)
  328. 3480 fr$(rs,m,n)=a$+"[171]"+b$+"[179]"+c$+"[177]":goto 3510
  329. 3490 if cu=3 then fr(rs,m,n)=cr(m,n):gosub 3640:goto 3510
  330. 3500 fr(rs,m,n)=200*cr(m,n)/(NULL):gosub 3640
  331. 3510 next:if ds then return
  332. 3520 for m=0 to 1:for n=0 to 2
  333. 3530 poke214,2*n+13:poke211,18*m+5:sys58732
  334. 3540 printc0$sc$fr$(rs,m,n):next:next
  335. 3550 k=(fr(rs,0,0)+fr(rs,0,1)+fr(rs,0,2))/2
  336. 3560 k=sqr(k*(k-fr(rs,0,0))*(k-fr(rs,0,1))*(k-fr(rs,0,2)))
  337. 3570 poke214,19:poke211,15:sys58732:printkc$k
  338. 3580 for n=0 to 2
  339. 3590 if fr(rs,0,n)=0 then h$="---":goto 3610
  340. 3600 h$=str$(2*k/fr(rs,0,n))
  341. 3610 poke214,21+n:poke211,5:sys58732:printc0$kc$h$:next
  342. 3620 if ds then return
  343. 3630 poke214,2*y+13:poke211,18*x+5:sys58732:mc=1:ms=8:goto 3880
  344. 3640 rem *** format output ***
  345. 3650 a$=str$(fr(rs,m,n))
  346. 3660 a$=right$(a$,len(a$)-1)
  347. 3670 fr$(rs,m,n)=a$:return
  348. 3680 rem ***
  349. 3690 rem ***
  350. 3700 rem ***
  351. 3710 rem *** check solution ***
  352. 3720 for l=0 to 1:gosub 3760:if fe then l=1:next:goto 3290
  353. 3730 next
  354. 3740 for l=0 to 1:gosub 3800:if fe then l=1:next:goto 3290
  355. 3750 next
  356. 3760 rem *** sub-check one ***
  357. 3770 for j=0 to 1:for k=0 to 2
  358. 3780 if cr(j,k)=0 then j=1:k=2:next:next:fe=1:em=6:return
  359. 3790 next:next:return
  360. 3800 rem *** sub-check two ***
  361. 3810 if cr(0,0)+cr(0,1)<=cr(0,2) then fe=1:em=6:return
  362. 3820 if cr(0,0)+cr(0,2)<=cr(0,1) then fe=1:em=6:return
  363. 3830 if cr(0,1)+cr(0,2)<=cr(0,0) then fe=1:em=6:return
  364. 3840 k=(cr(0,0)+cr(0,1)+cr(0,2))/2
  365. 3850 k=k*(k-cr(0,0))*(k-cr(0,1))*(k-cr(0,2))
  366. 3860 if k<0 then fe=1:em=16
  367. 3870 return
  368. 3880 rem *** print messages ***
  369. 3890 cs=peek(646):xs=peek(211):ys=peek(214)
  370. 3900 poke214,9:poke211,1:sys58732:printc1$mc$
  371. 3910 poke214,9:poke211,20-len(ms$(ms))/2:sys58732:printms$(ms)
  372. 3920 poke646,cs:poke214,ys:poke211,xs:sys58732:return
  373. 3930 rem *** read messages ***
  374. 3940 mc$="                                     "
  375. 3950 for n=0 to 20:readms$(n):next
  376. 3960 return
  377. 3970 rem *** flash message ***
  378. 3980 poke 198,0:j=peek(214):k=peek(211):l=peek(646):gosub 3880
  379. 3990 for n=1 to t0
  380. 4000 get a$:if a$="" then next:goto4020
  381. 4010 n=t0:next:poke214,j:poke211,k:sys58732:return
  382. 4020 sysad+30,1,38,9,9,32,1,1:for n=1 to t1
  383. 4030 get a$:if a$="" then next:sysad+30,1,38,9,9,32,9,1:goto3990
  384. 4040 n=t1:next:poke214,j:poke211,k:sys58732:sysad+30,1,38,9,8,32,9,1:return
  385. 4050 rem *** message data ***
  386. 4060 data "[211]tatus [207][203]":rem 0
  387. 4070 data "[211]olution one":rem 1
  388. 4080 data "[211]olution two":rem 2
  389. 4090 data "[206]o solution":rem 3
  390. 4100 data "[195]ontradictory data":rem 4
  391. 4110 data "[209]uit!? [193]re you sure? (y/n)":rem 5
  392. 4120 data "[201]mpossible triangle":rem 6
  393. 4130 data "[212]his triangle has two solutions...":rem 7
  394. 4140 data "[212]he complete solution is displayed":rem 8
  395. 4150 data "[198]atal error":rem 9
  396. 4160 data "[212][210][201][199][207][206]: [212]he trigonometry utility":rem 10
  397. 4170 data "[215]orking...":rem 11
  398. 4180 data "[206]eed at least one side":rem 12
  399. 4190 data "[208]ress '[200]' for help":rem 13
  400. 4200 data "[208]rint-out solution":rem 14
  401. 4210 data "[196]ivision by zero":rem 15
  402. 4220 data "[201]llegal quantity":rem 16
  403. 4230 data "[196]evice not present":rem 17
  404. 4240 data "end"
  405. 4250 data "end"
  406. 4260 data "end"
  407. 4270 rem *** help ***
  408. 4280 cs=peek(646):xs=peek(211):ys=peek(214):sysad+9,3
  409. 4290 sysad+15,0:sysad+3:sysad+18,1,1,7:poke53272,(peek(53272)and240)or10
  410. 4300 print"[154][147][212][210][201][199][207][206]"
  411. 4310 print"    [212][210][201][199][207][206] is a utility that will "
  412. 4320 print" quickly solve the unknown parts of "
  413. 4330 print" triangles for you.  [202]ust enter all the"
  414. 4340 print" known parts, and then press [198]1[154].  [201]n "
  415. 4350 print" seconds, the unknowns are calculated "
  416. 4360 print" and displayed."
  417. 4370 print"    [198]3[154] cycles through the circular"
  418. 4380 print" units that [212][210][201][199][207][206] uses to solve the
  419. 4390 [153]" triangles.  (NULL)hese units are:"
  420. 4400 [153]"     openstr$str$cont = str$ecimal str$egrees"
  421. 4410 [153]"     openstr$(NULL)(NULL)cont = str$egrees, (NULL)inutes, (NULL)econds"
  422. 4420 [153]"     open(NULL)atnstr$cont = (NULL)adians"
  423. 4430 [153]"     openchr$(NULL)atnstr$cont = chr$radians"
  424. 4440 [153]"    peeke sure you have set the circular"
  425. 4450 [153]" units to the desired value peekvalasc(NULL)(NULL)val you"
  426. 4460 [153]" enter your angles. (NULL)(NULL)(NULL)val: (NULL)hen in str$(NULL)(NULL)"
  427. 4470 [153]" 23-7<2.92> must be entered as:"
  428. 4480 [153]"23.070292"
  429. 4490 [153]"def >>> (NULL)ress any key <<< waitcont";:[151] 198,0:[158]ad[170]15,1
  430. 4500 [161] a$:[139] a$[178]"" [167] 4500
  431. 4510 [158]ad[170]15,0
  432. 4520 [153]"load(NULL)val(NULL)-(NULL)(NULL)val(NULL)(NULL)val(NULL)"
  433. 4530 [153]" asc1cont - (NULL)rders (NULL)(NULL)right$chr$(NULL)(NULL) to calculate"
  434. 4540 [153]"unknown parts."
  435. 4550 [153]" asc3cont - lenycles thru circular units."
  436. 4560 [153]" len(NULL)(NULL)cont - lenlears all registers in pre-"
  437. 4570 [153]"aration for a new problem."
  438. 4580 [153]" (NULL)cont - (NULL)uit (NULL)(NULL)right$chr$(NULL)(NULL) and return to (NULL)(NULL)atnstr$(NULL)(NULL)atn(NULL)."
  439. 4590 [153]" (NULL)cont - (NULL)end solution to printer."
  440. 4600 [153]" left$cont - lenalls these screens."
  441. 4610 [153]" (NULL)val(NULL)(NULL)(NULL)(NULL)cont must be pressed to enter the"
  442. 4620 [153]" new value into memory, otherwise"
  443. 4630 [153]" the previous value is retained."
  444. 4640 [153]" valntering a value of zero (0) will"
  445. 4650 [153]" clear that part.  (NULL)ee the docs for "
  446. 4660 [153]" worked examples."
  447. 4670 [153]"def >>> (NULL)ress any key <<< wait";:[151] 198,0:[158]ad[170]15,1
  448. 4680 [161] a$:[139] a$[178]"" [167] 4680
  449. 4690 [158]ad[170]15,0:[153]"sysload":[158]ad[170]12,3:[158]ad:[151]214,ys:[151]211,xs:[158] 58732
  450. 4700 [158]ad[170]18,12,12,7:[158]ad:[151]214,ys
  451. 4710 [158]ad[170]15,1:[158]ad:[151]646,cs:[142]
  452. 4720 [143] sysad+18,12,1,0
  453. 4730 v1[178][194](56576):v2[178][194](53272):[153]"load"
  454. 4740 [151]56578,[194](56578)[176]3:v0[178][194](56578)
  455. 4750 [151]56576,([194](56576)[175]252)[176]0
  456. 4760 [151]53272,([194](53272)[175]15)[176]48
  457. 4770 [151] 648,204
  458. 4780 [153]"loadprint   stop printwait ghstop printwait  stop      defwait                     ";
  459. 4790 [153]"   sys   print  '(  sys         stop              syswait        ";
  460. 4800 [153]"  print  ascchr$left$right$mid$  sys    tuvwxyz[sys ]^sys tuvwxyz[\]^_syswait ";
  461. 4810 [153]"poke sys printtofnspc( not +-* sys    (NULL)(NULL)sys 89:;sys =>sys 456789:;<=>";
  462. 4820 [153]"?syswait print  de  hi klmwait  sys  def(NULL)(NULL)sys def(NULL)(NULL)(NULL)(NULL)sys def(NULL)(NULL)sys def(NULL)(NULL)(NULL)(NULL)(NULL)(NULL)(NULL)";
  463. 4830 [153]"(NULL)(NULL)(NULL)(NULL)(NULL)syswait print!#$   wait@    -./wait sys defintabsprint deffrepossqrrndsys defexpcossys defsgnintabs";
  464. 4840 [153]"usrfrepossqrrndlogexpcossinsyswait printpeeklenstr$valascchr$left$right$mid$(NULL)(NULL)(NULL)(NULL)(NULL)(NULL)syswait                   ";
  465. 4850 [153]"      print      notstepwait                                poke";
  466. 4860 [153]"freloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogloglogposcoswait       ";
  467. 4870 [153]"                               sinintabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabs";
  468. 4880 [153]"absabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsabsusrcossyswait        cont(NULL)right$str$val(NULL)sys         ";
  469. 4890 [153]"contatn(NULL)chr$(NULL)val(NULL) clr( str$str$ )sys   pokesincossyswait cont  sys               cont  sys ";
  470. 4900 [153]"                 pokesincossyswait conta=sys               cont atn=sys  ";
  471. 4910 [153]"               pokesincossyswait cont  sys               cont  sys     ";
  472. 4920 [153]"             pokesincossyswait contb=sys               cont peek=sys      ";
  473. 4930 [153]"           pokesincossyswait cont  sys               cont  sys         ";
  474. 4940 [153]"         pokesincossyswait contc=sys               cont len=sys          ";
  475. 4950 [153]"       pokesincossyswait         cont     sys                     ";
  476. 4960 [153]"   pokesincossyswait         contatnrea=sys                        poke";
  477. 4970 [153]"sincossyswait                                      pokesincossyswait ";
  478. 4980 [153]"contha=sys                                  pokesincossyswait conthb=";
  479. 4990 [153]"sys                                  pokesincossyswait conthc=sys   ";
  480. 5000 [153]"                               pokesinsqrexpexpexpexpexpexpexpexpexpexpexpexpexpexpexp";
  481. 5010 [153]"expexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexpexp"
  482. 5020 [151]53280,11:[151]53281,00:[151]53223,251:[151]56295,11
  483. 5030 [151]53282,04:[151]53283,04:[151]53284,05
  484. 5040 [158]ad[170]6:[158]ad:[158]ad[170]15,1:[142]
  485. 5050 [172][172][172] [153]er [129]mat subrs [172][172][172]
  486. 5060 [139] cu[178]2 [167] 5080
  487. 5070 [153]fr$(a,1,b);:[142]
  488. 5080 [129] n[178]1 [164] [195](fr$(a,1,b))
  489. 5090 [139] [202](fr$(a,1,b),n,1)[178]"-"[167] [153]"d ";:[130]:[142]
  490. 5100 [139] [202](fr$(a,1,b),n,1)[178]"<"[167] [153]"m ";:[130]:[142]
  491. 5110 [139] [202](fr$(a,1,b),n,1)[178]">"[167] [153]"s";:[130]:[142]
  492. 5120 [153][202](fr$(a,1,b),n,1);:[130]:[142]
  493. 5130 k[178](fr(a,0,0)[170]fr(a,0,1)[170]fr(a,0,2))[173]2
  494. 5140 k(a)[178][186](k[172](k[171]fr(a,0,0))[172](k[171]fr(a,0,1))[172](k[171]fr(a,0,2))):[153]k(a);:[142]
  495. 5150 [139] fr(a,0,b)[178]0 [167] [142]
  496. 5160 [153]2[172]k(a)[173]fr(a,0,b);:[142]
  497. 10000 [159]15,8,15,"s0:trigon":[160]15:[148]"trigon",8:[128]
  498. 40000 a$[178]"hello connect":[129]i[178]8[164]9:[160]2:[159]2,i,2:[160]2:[139]st[167]40020
  499. 40010 [160]15:[159]15,i,15,"r0:"[170]a$[170]"="[170]a$:[132]15,er:[160]15:[139]er[178]63[167]40030
  500. 40020 [130]:[153]"load":[151]2048,0:[151]44,8:[151]53272,23:[151]186,8:[128]
  501. 40030 [151]646,[194](53281):[153]"loadload"[199](34)a$[199](34)","i
  502. 40040 [153]"run":[151]44,8:[151]2048,0:[151]631,13:[151]632,13:[151]198,2:[128]
  503. 60000 [153]"load":z$[178]" print#                                      ":[151]214,10:[153]
  504. 60010 [153]" listfrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefrefre":[129]i[178]0[164]11:[153]z$:[130]
  505. 60020 [153]" pokeposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposposprint#"
  506. 60030 z$(0)[178]"(NULL) (NULL) right$ chr$ (NULL) (NULL)":z$(1)[178]"by (NULL)ichael mid$. chr$ulyas
  507. 60040 z$(2)="([195]) 1994 by [211]oftdisk [208]ublishing"+chr$(13)
  508. 60050 z$(3)="[212]his program is the copyrighted work
  509. 60060 z$(4)[178]"of (NULL)(NULL)asc(NULL)str$right$(NULL)(NULL) (NULL)(NULL)peek(NULL)right$(NULL)left$right$(NULL)chr$.  right$t is not"
  510. 60070 z$(5)[178]"shareware or in the public domain."
  511. 60080 z$(6)[178]"(NULL)eport illegal distribution of":z$(7)[178]"this program by calling"
  512. 60090 z$(8)[178]"1-318-221-8718.":[151]214,12:[153]
  513. 60100 [129]i[178]0[164]8:[153][163]20[171]([195](z$(i))[173]2))""z$(i):[130]:[142]
  514.