home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Productivity Pak 1 / rerun-productivity-pak-i.d64 / graphmaker (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  175 lines
  1. 1 rem *******************************
  2. 2 rem *                             *
  3. 3 rem *      graphmaker 64 (c) 1984 *
  4. 4 rem *         doug smoak          *
  5. 5 rem *         303 heyward st.     *
  6. 6 rem *         columbia sc 29201   *
  7. 7 rem *         (803)-765-1189      *
  8. 8 rem *                             *
  9. 9 rem *******************************
  10. 10 bo=53280:bg=bo+1:pokebg,0:pokebo,0:poke56296,0
  11. 20 ov$=""
  12. 30 dn$=""
  13. 40 bl$=dn$+""+"                                      "
  14. 50 cc=4:dimfr$(7),t$(36),v(36),cl$(7),f$(2),s(2),e(2)
  15. 60 s(1)=1024:e(1)=2024:s(2)=55296:e(2)=56297
  16. 70 cl$(0)="[152]":cl$(1)="[158]":cl$(2)="[129]":cl$(3)="":cl$(4)="[156]":cl$(5)=""
  17. 80 cl$(6)="[154]":cl$(7)="[155]"
  18. 90 print"[147][152]              graphmaker 64"
  19. 100 print"c_create a graph":print"l_load a graph"
  20. 110 getg$:on-(g$="")goto110:ifg$<>"l"andg$<>"c"then110
  21. 120 ifg$="l"then1170
  22. 130 input"[147]maximum vertical scale value";mx:bi=mx/20:li=bi/7:ifmx=<0then130
  23. 140 gosub280:gosub570
  24. 150 fori=1tovb
  25. 160 print"[147]value to be graphed":print"for bar #"i"[157], "t$(i);
  26. 170 inputv(i):ifv(i)>mxthenv(i)=mx
  27. 180 gosub390
  28. 190 next:printgr$mx$
  29. 200 :
  30. 210 rem ** loop for bars **
  31. 220 :
  32. 230 forc=1tovb:v=v(c):v=v-3*(bi/7):gosub460:next
  33. 240 goto810
  34. 250 :
  35. 260 rem ** set up parameters **
  36. 270 :
  37. 280 print"[147]how many vertical bars":print"(2-36) ";:inputvb
  38. 290 ifvb>36orvb<2then280
  39. 300 bw=int(36/vb)
  40. 310 fori=1tovb
  41. 320 print"[147]title for bar #"i:print"up to"bw"characters";
  42. 330 inputt$(i):ift$(i)=""thent$(i)=str$(i)
  43. 340 iflen(t$(i))>bwand(bw>2)then320
  44. 350 next:return
  45. 360 :
  46. 370 rem ** center routine **
  47. 380 :
  48. 390 ifbw<3thent$(i)=right$(t$(i),1):return
  49. 400 iflen(t$(i))=bwthenreturn
  50. 410 mr=bw-len(t$(i)):mr=mr/2:ifmr<1thenreturn
  51. 420 mr$="":forj=1tomr:c$=""+c$:next:t$(i)=c$+t$(i):c$="":return
  52. 430 :
  53. 440 rem ** chart routine**
  54. 450 :
  55. 460 ifv<liandv(c)>0thenfr=1:goto480
  56. 470 ifv>0thenbl=int(v/bi):f=v-bl*bi:fr=int(f/li)
  57. 480 cc$=left$(ov$,cc)
  58. 490 printdn$"[152]"cc$t$(c);
  59. 500 print""cl$(cand7)
  60. 510 printdn$cc$;:ifbl=0then530
  61. 520 fori=1tobl:printcl$;:next
  62. 530 iffr>0thenprintfr$(fr)
  63. 540 cc=cc+bw:bl=0:fr=0:return
  64. 550 :
  65. 560 rem ** set up strings **
  66. 570 :
  67. 580 mx$=str$(mx):mx$=right$(mx$,len(mx$)-1)
  68. 590 mx$=left$(mx$,3):j=3-len(mx$):ifj=0then610
  69. 600 fori=1toj:m$=" "+m$:next:mx$=m$+mx$:m$=""
  70. 610 hf=100*mx:hf=int(hf/2):hf=hf/100:hf$=str$(hf)
  71. 620 hf$=right$(hf$,len(hf$)-1):hf$=left$(hf$,3)
  72. 630 j=3-len(hf$):ifj=0then650
  73. 640 fori=1toj:m$=m$+" ":next:hf$=m$+hf$:m$=""
  74. 650 ifval(hf$)>val(mx$)thenhf$=left$(" "+hf$,3)
  75. 660 mx$=""+mx$+"[157][157][157]"+hf$
  76. 670 gr$="[221][157][171][157]":fori=1to4:c$=c$+gr$:next:c$=c$
  77. 680 c$="[152][147][171][157]"+c$
  78. 690 fori=1to5:c$=c$+gr$:next:gr$=c$+"[221][157]":c$=""
  79. 700 gr$=gr$+"[157]0[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
  80. 710 fori=1tobw:c$=c$+" ":next:cl$=c$:c$=""
  81. 720 fori=1tobw:c$=c$+"[157]":next:cl$=""+cl$+c$+"[145][146]":c$=""
  82. 730 fr$="[164][175][185][162][184][183][163]":fori=1to7:fr$(i)=mid$(fr$,i,1)
  83. 740 ifi>4thenfr$(i)=""+fr$(i)+"[146]"
  84. 750 next
  85. 760 fori=1to7:forj=1tobw:f$=f$+fr$(i):nextj:fr$(i)=f$:f$="":nexti
  86. 770 return
  87. 780 :
  88. 790 rem** input for s/l,title ,etc.**
  89. 800 :
  90. 810 printdn$"[152]<t>ext <s>ave <a>bort <l>oad <p>rint":fort=1to800:next
  91. 820 getg$:ifg$<>""thenprintbl$:goto840
  92. 830 printbl$:fort=1to125:next:goto810
  93. 840 ifg$="a"thenrun
  94. 850 ifg$="l"then1170
  95. 860 ifg$="t"then1250
  96. 870 ifg$="p"then1460
  97. 880 ifg$<>"s"then810
  98. 890 :
  99. 900 rem ** get save filename **
  100. 910 :
  101. 920 f$="":printdn$"filename? [166][157]";
  102. 930 getg$:on-(g$="")goto930
  103. 940 ifasc(g$)>31andasc(g$)<96thenf$=f$+g$
  104. 950 ifg$<>chr$(13)thenprint" [157]"g$"[166][157]";:goto930
  105. 960 printbl$:iff$=""then810
  106. 970 iflen(f$)>14then920
  107. 980 f$(1)=f$:f$(2)=f$+".c"
  108. 990 op$="s":forj=1to2:f$=f$(j)
  109. 1000 s=s(j):e=e(j)
  110. 1010 gosub1050:next:gosub1600:goto810
  111. 1020 :
  112. 1030 rem ** save and load**
  113. 1040 :
  114. 1050 fori=1tolen(f$):poke819+i,asc(mid$(f$,i,1)):next
  115. 1060 poke183,len(f$):poke187,52:poke188,3:poke186,8:poke185,1
  116. 1070 ifop$="l"then1210
  117. 1080 :
  118. 1090 rem ** save **
  119. 1100 :
  120. 1110 sh=int(s/256):sl=s-sh*256:eh=int(e/256):el=e-eh*256
  121. 1120 poke251,sl:poke252,sh:poke780,251:poke781,el:poke782,eh
  122. 1130 sys65496:return
  123. 1140 :
  124. 1150 rem ** load **
  125. 1160 :
  126. 1170 input"[147]exact filename";f$:iff$=""orlen(f$)>14then1170
  127. 1180 f$(1)=f$:f$(2)=f$+".c"
  128. 1190 forj=1to2:f$=f$(j):op$="l":gosub1050
  129. 1200 next:gosub1600:goto810
  130. 1210 poke780,0:sys65493:return
  131. 1220 :
  132. 1230 rem ** cursor routine **
  133. 1240 :
  134. 1250 sc=1024:cr=55296
  135. 1260 ifin<0thenin=0
  136. 1270 ifin>959thenin=959
  137. 1280 om=peek(sc+in):oc=peek(cr+in)
  138. 1290 pokesc+in,(peek(sc+in)+128)and255:pokecr+in,peek(646)
  139. 1300 getg$:on-(g$="")goto1290
  140. 1310 ifg$="\"thengosub1410:goto810
  141. 1320 ifg$="[148]"org$=""theng$="[157]"
  142. 1330 ifg$=chr$(13)thenom=(om+128)and255:gosub1410:in=in+1:goto1260
  143. 1340 ifg$=""thengosub1410:in=(in+1):goto1260
  144. 1350 ifg$="[157]"thengosub1410:in=(in-1):goto1260
  145. 1360 ifg$="[145]"thengosub1410:in=(in-40):goto1260
  146. 1370 ifg$=""thengosub1410:in=(in+40):goto1260
  147. 1380 sp=in:gosub1420:printg$
  148. 1390 ifasc(g$)>31andasc(g$)<128thenin=in+1
  149. 1400 goto1260
  150. 1410 pokesc+in,om:pokecr+in,oc:return
  151. 1420 y=int(sp/40):x=sp-40*y:poke781,y:poke782,x:sys65520:return
  152. 1430 :
  153. 1440 rem ** printer dump **
  154. 1450 :
  155. 1460 r$=chr$(145):v$=chr$(146):open4,4:cmd4:g=peek(648)*256
  156. 1470 printr$+chr$(14);
  157. 1480 forp=gtog+999
  158. 1490 c=peek(p):c$=""
  159. 1500 if(p-g)/40=int((p-g)/40)thenprintchr$(8)+chr$(13)+chr$(14);
  160. 1510 ifc>128thenc=c-128:c$=chr$(18)
  161. 1520 ifc<32orc>95thenc=c+64:goto1540
  162. 1530 ifc>63andc<96thenc=c+128
  163. 1540 c$=c$+chr$(c):iflen(c$)>1thenc$=c$+v$+r$
  164. 1550 printc$;:next:print#4:close4
  165. 1560 goto810
  166. 1570 :
  167. 1580 rem ** read disk error ch **
  168. 1590 :
  169. 1600 open15,8,15:input#15,a,b$,c,d
  170. 1610 close15
  171. 1620 ifa=0thenreturn
  172. 1630 printbl$dn$""a"[157] "b$" error":fort=1to850:next
  173. 1640 getg$:ifg$<>""thenreturn
  174. 1650 printdn$"press any key to continue":fort=1to850:next:goto1630
  175.