home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Run Magazine ReRun 1985 Summer
/
rerun-1985-summer-side-b.d64
/
graphmaker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
5KB
|
175 lines
1 rem *******************************
2 rem * *
3 rem * graphmaker 64 (c) 1984 *
4 rem * doug smoak *
5 rem * 303 heyward st. *
6 rem * columbia sc 29201 *
7 rem * (803)-765-1189 *
8 rem * *
9 rem *******************************
10 bo=53280:bg=bo+1:pokebg,0:pokebo,0:poke56296,0
20 ov$=""
30 dn$=""
40 bl$=dn$+""+" "
50 cc=4:dimfr$(7),t$(36),v(36),cl$(7),f$(2),s(2),e(2)
60 s(1)=1024:e(1)=2024:s(2)=55296:e(2)=56297
70 cl$(0)="[152]":cl$(1)="[158]":cl$(2)="[129]":cl$(3)="":cl$(4)="[156]":cl$(5)=""
80 cl$(6)="[154]":cl$(7)="[155]"
90 print"[147][152] graphmaker 64"
100 print"c_create a graph":print"l_load a graph"
110 getg$:on-(g$="")goto110:ifg$<>"l"andg$<>"c"then110
120 ifg$="l"then1170
130 input"[147]maximum vertical scale value";mx:bi=mx/20:li=bi/7:ifmx=<0then130
140 gosub280:gosub570
150 fori=1tovb
160 print"[147]value to be graphed":print"for bar #"i"[157], "t$(i);
170 inputv(i):ifv(i)>mxthenv(i)=mx
180 gosub390
190 next:printgr$mx$
200 :
210 rem ** loop for bars **
220 :
230 forc=1tovb:v=v(c):v=v-3*(bi/7):gosub460:next
240 goto810
250 :
260 rem ** set up parameters **
270 :
280 print"[147]how many vertical bars":print"(2-36) ";:inputvb
290 ifvb>36orvb<2then280
300 bw=int(36/vb)
310 fori=1tovb
320 print"[147]title for bar #"i:print"up to"bw"characters";
330 inputt$(i):ift$(i)=""thent$(i)=str$(i)
340 iflen(t$(i))>bwand(bw>2)then320
350 next:return
360 :
370 rem ** center routine **
380 :
390 ifbw<3thent$(i)=right$(t$(i),1):return
400 iflen(t$(i))=bwthenreturn
410 mr=bw-len(t$(i)):mr=mr/2:ifmr<1thenreturn
420 mr$="":forj=1tomr:c$=""+c$:next:t$(i)=c$+t$(i):c$="":return
430 :
440 rem ** chart routine**
450 :
460 ifv<liandv(c)>0thenfr=1:goto480
470 ifv>0thenbl=int(v/bi):f=v-bl*bi:fr=int(f/li)
480 cc$=left$(ov$,cc)
490 printdn$"[152]"cc$t$(c);
500 print""cl$(cand7)
510 printdn$cc$;:ifbl=0then530
520 fori=1tobl:printcl$;:next
530 iffr>0thenprintfr$(fr)
540 cc=cc+bw:bl=0:fr=0:return
550 :
560 rem ** set up strings **
570 :
580 mx$=str$(mx):mx$=right$(mx$,len(mx$)-1)
590 mx$=left$(mx$,3):j=3-len(mx$):ifj=0then610
600 fori=1toj:m$=" "+m$:next:mx$=m$+mx$:m$=""
610 hf=100*mx:hf=int(hf/2):hf=hf/100:hf$=str$(hf)
620 hf$=right$(hf$,len(hf$)-1):hf$=left$(hf$,3)
630 j=3-len(hf$):ifj=0then650
640 fori=1toj:m$=m$+" ":next:hf$=m$+hf$:m$=""
650 ifval(hf$)>val(mx$)thenhf$=left$(" "+hf$,3)
660 mx$=""+mx$+"[157][157][157]"+hf$
670 gr$="[221][157][171][157]":fori=1to4:c$=c$+gr$:next:c$=c$
680 c$="[152][147][171][157]"+c$
690 fori=1to5:c$=c$+gr$:next:gr$=c$+"[221][157]":c$=""
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]"
710 fori=1tobw:c$=c$+" ":next:cl$=c$:c$=""
720 fori=1tobw:c$=c$+"[157]":next:cl$=""+cl$+c$+"[145][146]":c$=""
730 fr$="[164][175][185][162][184][183][163]":fori=1to7:fr$(i)=mid$(fr$,i,1)
740 ifi>4thenfr$(i)=""+fr$(i)+"[146]"
750 next
760 fori=1to7:forj=1tobw:f$=f$+fr$(i):nextj:fr$(i)=f$:f$="":nexti
770 return
780 :
790 rem** input for s/l,title ,etc.**
800 :
810 printdn$"[152]<t>ext <s>ave <a>bort <l>oad <p>rint":fort=1to800:next
820 getg$:ifg$<>""thenprintbl$:goto840
830 printbl$:fort=1to125:next:goto810
840 ifg$="a"thenrun
850 ifg$="l"then1170
860 ifg$="t"then1250
870 ifg$="p"then1460
880 ifg$<>"s"then810
890 :
900 rem ** get save filename **
910 :
920 f$="":printdn$"filename? [166][157]";
930 getg$:on-(g$="")goto930
940 ifasc(g$)>31andasc(g$)<96thenf$=f$+g$
950 ifg$<>chr$(13)thenprint" [157]"g$"[166][157]";:goto930
960 printbl$:iff$=""then810
970 iflen(f$)>14then920
980 f$(1)=f$:f$(2)=f$+".c"
990 op$="s":forj=1to2:f$=f$(j)
1000 s=s(j):e=e(j)
1010 gosub1050:next:gosub1600:goto810
1020 :
1030 rem ** save and load**
1040 :
1050 fori=1tolen(f$):poke819+i,asc(mid$(f$,i,1)):next
1060 poke183,len(f$):poke187,52:poke188,3:poke186,8:poke185,1
1070 ifop$="l"then1210
1080 :
1090 rem ** save **
1100 :
1110 sh=int(s/256):sl=s-sh*256:eh=int(e/256):el=e-eh*256
1120 poke251,sl:poke252,sh:poke780,251:poke781,el:poke782,eh
1130 sys65496:return
1140 :
1150 rem ** load **
1160 :
1170 input"[147]exact filename";f$:iff$=""orlen(f$)>14then1170
1180 f$(1)=f$:f$(2)=f$+".c"
1190 forj=1to2:f$=f$(j):op$="l":gosub1050
1200 next:gosub1600:goto810
1210 poke780,0:sys65493:return
1220 :
1230 rem ** cursor routine **
1240 :
1250 sc=1024:cr=55296
1260 ifin<0thenin=0
1270 ifin>959thenin=959
1280 om=peek(sc+in):oc=peek(cr+in)
1290 pokesc+in,(peek(sc+in)+128)and255:pokecr+in,peek(646)
1300 getg$:on-(g$="")goto1290
1310 ifg$="\"thengosub1410:goto810
1320 ifg$="[148]"org$=""theng$="[157]"
1330 ifg$=chr$(13)thenom=(om+128)and255:gosub1410:in=in+1:goto1260
1340 ifg$=""thengosub1410:in=(in+1):goto1260
1350 ifg$="[157]"thengosub1410:in=(in-1):goto1260
1360 ifg$="[145]"thengosub1410:in=(in-40):goto1260
1370 ifg$=""thengosub1410:in=(in+40):goto1260
1380 sp=in:gosub1420:printg$
1390 ifasc(g$)>31andasc(g$)<128thenin=in+1
1400 goto1260
1410 pokesc+in,om:pokecr+in,oc:return
1420 y=int(sp/40):x=sp-40*y:poke781,y:poke782,x:sys65520:return
1430 :
1440 rem ** printer dump **
1450 :
1460 r$=chr$(145):v$=chr$(146):open4,4:cmd4:g=peek(648)*256
1470 printr$+chr$(14);
1480 forp=gtog+999
1490 c=peek(p):c$=""
1500 if(p-g)/40=int((p-g)/40)thenprintchr$(8)+chr$(13)+chr$(14);
1510 ifc>128thenc=c-128:c$=chr$(18)
1520 ifc<32orc>95thenc=c+64:goto1540
1530 ifc>63andc<96thenc=c+128
1540 c$=c$+chr$(c):iflen(c$)>1thenc$=c$+v$+r$
1550 printc$;:next:print#4:close4
1560 goto810
1570 :
1580 rem ** read disk error ch **
1590 :
1600 open15,8,15:input#15,a,b$,c,d
1610 close15
1620 ifa=0thenreturn
1630 printbl$dn$""a"[157] "b$" error":fort=1to850:next
1640 getg$:ifg$<>""thenreturn
1650 printdn$"press any key to continue":fort=1to850:next:goto1630