home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 120 / 120.d81 / trigon (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  18KB  |  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+