home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 83
/
083.d81
/
cal.print
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
14KB
|
406 lines
100 poke 55,0:poke 56,160:clr:n$="ab":goto220
110 :
120 sys 52496,fr,fc,tr,tc,ad,fu,co,rv
130 ad=ad+(tr-fr+1)*(tc-fc+1)*2:n=n+1
140 if ad>52495thenprint"windows abort!":end
150 fr(n)=fr:fc(n)=fc:tr(n)=tr:tc(n)=tc
160 return
170 :
180 fr=fr(n):fc=fc(n):tr=tr(n):tc=tc(n)
190 ad=ad-(tr-fr+1)*(tc-fc+1)*2:n=n-1
200 sys 52496,fr,fc,tr,tc,ad,8,1,1
210 return
220 de=peek(186):ifde<8thende=8
230 dim la(12),lw$(7),mm$(4),l$(12)
240 dim la$(106),lb(106),lc(106),lp(106),pi(21)
250 l$(1)="[197]ach ":l$(2)="[199]ram ":l$(3)="[207]unce":l$(4)="[208]ound":l$(5)="[212]sp "
260 l$(6)="[212]bl ":l$(7)="[207]unce":l$(8)="[195]up ":l$(9)="[208]int ":l$(10)="[209]uart"
270 l$(11)="[199]al ":l$(12)=" "
280 a3$=chr$(125):a6$="[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]"
290 la(1)=0.:la(2)=31.:la(3)=59.:la(4)=90.:la(5)=120.:la(6)=151.
300 la(7)=181.:la(8)=212.:la(9)=243.:la(10)=273.:la(11)=304.:la(12)=334.
310 lw$(0)="[211][213][206]":lw$(1)="[205][207][206]":lw$(2)="[212][213][197]":lw$(3)="[215][197][196]":lw$(4)="[212][200][210]"
320 lw$(5)="[198][210][201]":lw$(6)="[211][193][212]"
330 mm$(1)="[194][203][198][193][211][212]":mm$(2)="[204][213][206][195][200] ":mm$(3)="[196][201][206][206][197][210]":mm$(4)="[211][206][193][195][203] "
340 ss$=" ":zc=0:z$=chr$(0):lm=66
350 forx=900to933:ready:pokex,y:next
360 gosub610
370 gosub1770:ifga=1 then 390
380 ifga=2then 2450
390 gosub690:ifbt=0then 370
400 yy=22:xx=0:gosub600:print"f1 = [208]age <[210][212][206]> = [211]elect _ = [197]scape"
410 goto 2140
420 data 160,2,177,45,153,137,0,200,192,6,208,246,162
430 data 1,32,198,255,32,228,255,164,142,145,140,200
440 data 132,142,196,139,208,242,76,204,255
450 fr=21:fc=09:tr=23:tc=29:fu=7 :co=0 :rv=02:gosub120
460 yy=23:xx=10:gosub600
470 print" [193]ny [203]ey [195]ontinues";
480 poke198,0:wait198,15:geta$:gosub180:return
490 if zc=1then return
500 fr=18:fc=08:tr=22:tc=32:fu=7 :co=2 :rv=12:gosub120:yy=21:xx=09:gosub600
510 print"[152] [204]oading [196]irectory ":gosub1080:gosub180:return
520 gosub590:print"[147]new":print"load"chr$(34)f$chr$(34)","de
530 print"?c[200](144)c[200](142):run"
540 poke198,3:poke631,13:poke632,13:poke633,13:poke56,160:end
550 input#15,e,e$,a,b:ife<20 orre=73 then return
560 if e=50thenreturn
570 print "[147] [196][201][211][203] [208][210][207][194][204][197][205]: [195]an't [195]ontinue!":gosub450
580 gosub590:end
590 close3:close15:open15,de,15,"i0":close15:return
600 poke 214,yy:poke211,xx:print"[145]";:return
610 rem hskpng
620 poke53281,1:poke53280,1
630 dim dp$(53),dc$(53):dp=1:dp$(1)=chr$(255):dc=1:dc$(1)=chr$(255)
640 dim fr(20),fc(20),tr(20),tc(20)
650 ad=49920
660 rempoke 147,0:sys57812"windows.o",de,1:sys62631:poke53281,1
670 yy=10:xx=10:gosub600
680 return:poke147,0:sys57812"cal.rd.o",de,1:sys62631:return
690 print"[147]":poke53280,1:fr=07:fc=10:tr=15:tc=30:fu=7 :co=0 :rv=02:gosub120
700 yy=9:xx=13:gosub600:print"[193][206][193][204][217][218][197] & [208][210][201][206][212]":yy=10:gosub600
710 print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]":yy=11:xx=16:gosub600:print"[197]nter [206]ame":xx=15
720 a7$="":a5$="a":al=8:a2$="":yy=13:gosub750:pn$=left$(a1$+"........",8)
730 gosub500:gosub180:ifbt=0then return
740 gosub1430:return
750 rem get routine
760 a1$=""
770 gosub970
780 get a$:if a$="" then 780
790 a=asc(a$):if a=20 thengosub1000:goto860.
800 if a=13then 880
810 if a5$="a"then 1020
820 if a$="."ora$="," then850
830 if a$ = "-" and len(a1$) = 0 then 850
840 if a < 48 or a > 60 then 780
850 iflen(a1$)<al then a1$=a1$+a$
860 gosub870:goto 780
870 gosub970:return
880 dv=0:l =len(a1$):a = 0:at = 0:p = 0:an = 1
890 if a5$="a"then return
900 for i=1 to l:a$ = mid$(a1$,i,1)
910 if a$="-" then an=-1:goto 960
920 ifa$=","then 960
930 if a$="."thendv=1:goto 960
940 if dv=0 then a=val(a$):at = at*10 + a
950 if dv=1 then p=p+1:a=val(a$):at = at + a/(10^p)
960 next:at=at*an:return
970 a4$=left$(a6$,al)
980 gosub600:printa7$;a2$;" "; a3$;a1$" ";spc(al-len(a1$));"[157]"a3$
990 print a7$;spc(xx+ len(a2$)+1);chr$(173);a4$;chr$(189);"[145][145]":return
1000 l=len(a1$):ifl=0then return
1010 l=l-1:a1$=mid$(a1$,1,l):return
1020 if a> 31 and a <94 then 850
1030 if a> 159 and a <221 then 850
1040 goto 780
1050 mm=int(mc/100000000):mc=mc-mm*100000000:mt=int(mc/10000):mf=mc-mt*10000
1060 md=int(mu/10000000):mu=mu-md*10000000:mx=int(mu/100):mq=mu-mx*100
1070 return
1080 rem get directory
1090 n$="az":forx=1to6:n$=n$+n$:next:n$=mid$(n$,2):n$=n$+n$
1100 dp=1:dp$(1)=chr$(255):dc=1:dc$(1)=chr$(255)
1110 close15:open15,de,15,"i0":gosub550:open1,de,2,"$":gosub550:bt=0
1120 sys900:gosub550
1130 sys900:forx=1to254step32:a=asc(mid$(n$,x,1))
1140 if a<>129 then 1180
1150 a=asc(mid$(n$,x+3,1)):ifa<>037 then 1180
1160 a=asc(mid$(n$,x+4,1)):if a=33 then 1240*
1170 ifa=36 then 1260*
1180 next:ifst=0 then 1130
1190 ifbt=0 then 1210
1200 close1:close15:return
1210 fr=10:fc=8:tr=15:tc=33:fu=7:co=.:rv=5:gosub120:print""
1220 yy=14:xx=10:gosub600:print"[206]ame [206]ot in [196]irectory!"
1230 gosub 450:gosub180:goto1200
1240 a1$=mid$(n$,x+5,8):ifa1$<>pn$then1180
1250 bt=1:a1$=mid$(n$,x+13,6):gosub1350:goto1180
1260 a1$=mid$(n$,x+5,8):ifa1$<>pn$then1180
1270 bt=1:a1$=mid$(n$,x+13,6):gosub1390:goto1180
1280 a$=" [208][204][193][206] ":if cx=1thena$="[195][207][206][211][213][205][208][212][201][207][206]"
1290 print#4,spc(3);a$;" for ";pn$;spc(30);"[196][193][212][197]: ";n$
1300 print#4,spc(15);" [215][197][201][199][200][212]: ";wa/10;spc(22);" -- [195][193][204][207][210][201][197][211] --"
1310 a$="[198][193][212] [212][207][212]"
1320 print#4,spc(5);". . . . [197][206][212][210][217] . . . . . . . ."spc(9);"[209][213][193][206][212][201][212][217]"spc(6)a$
1330 gosub2430:gc=4:return
1340 for ga=1to(66-gc):print#4,:next:gosub1280:return
1350 k=0
1360 k=k+1:ifa1$>dp$(k)then 1360
1370 dp=dp+1:forj=dptokstep-1:dp$(j)=dp$(j-1):next
1380 dp$(k)=a1$:return
1390 k=0
1400 k=k+1:ifa1$>dc$(k)then 1400
1410 dc=dc+1:forj=dctokstep-1:dc$(j)=dc$(j-1):next
1420 dc$(k)=a1$:return
1430 fr=3:fc=7:tr=20:tc=17:fu=7:co=.:rv=6:gosub120:print""
1440 fr=3:fc=24:tr=20:tc=34:fu=7:co=.:rv=6:gosub120
1450 yy=1:xx=12:gosub600:ifga=1then print"[211]elect [201]tem to [208]rint."
1460 if ga=2 then print"[207]rder for [193]nalysis!"
1470 yy=5:xx=10:gosub600:print"[208][204][193][206] ";spc(12);"[193][195][212][213][193][204]"
1480 yy=7:gosub600
1490 gosub1560:gosub1570:pp=1:cp=1:gosub1580:gosub1660:return
1500 fr=10:fc=08:tr=15:tc=33:fu=7:co=.:rv=4:gosub120:print"[156]"
1510 yy=13:xx=10:gosub600:print" [208][210][201][206][212][197][210] [213][206][193][214][193][201][204][193][194][204][197]!"
1520 gosub 450:gosub180:return
1530 fr=10:fc=08:tr=15:tc=33:fu=7:co=.:rv=4:gosub120:print"[156]"
1540 yy=13:xx=10:gosub600:print" [193][204][201][199][206] [212][207] [212][207][208] [207][198] [198][207][210][205]!"
1550 gosub 450:gosub180:return
1560 yy=6:xx=0:gosub600:forj=1to14:printtab(10);" ":next:return
1570 yy=6:xx=0:gosub600:forj=1to14:printtab(27);" ":next:return
1580 yy=6:xx=0:gosub600:ps=pp
1590 ifpp>dpthen 1640
1600 if (pp-ps)>12 then 1630
1610 if dp$(pp)=chr$(255) then 1640
1620 printtab(10);"";dp$(pp):pp=pp+1:goto1590
1630 print tab(11);"[205][207][210][197]":bp=12:return
1640 if ps=pp and dp>1 then pp=1:goto1580
1650 print tab(11);"[197][206][196]":bp=pp-ps-1:return
1660 yy=6:xx=0:gosub600:cs=cp
1670 ifcp>dcthen 1720
1680 if (cp-cs)>12 then 1710
1690 if dc$(cp)=chr$(255) then 1720
1700 printtab(27);"";dc$(cp):cp=cp+1:goto1670
1710 print tab(28);"[205][207][210][197]":bc=12:return
1720 if cs=cp and dc>1 then cp=1:goto1660
1730 print tab(28);"[197][206][196]":bc=cp-cs-1:return
1740 ifa$="[139]" or a$="[134]" ora$="[135]" or a$="[136]" thenreturn
1750 if a$="_"then return
1760 goto 1920
1770 gosub5000:print"":fr=10:fc=7:tr=20:tc=33:fu=7:co=.:rv=2:gosub120:print""
1780 yy=12:xx=0:gosub600:print tab(13);"[193][206][193][204][217][218][197] & [208][210][201][206][212]"
1790 print tab(13);"[163][163][163][163][163][163][163][163][163][163][163][163][163