home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 93
/
093.d81
/
4684
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
7KB
|
226 lines
0 dv=peek(186):ifdv<8thendv=8
1 ifa=0thena=1:load"help-4684",dv,1
2 ifa=1thena=2:load"notepad",dv,1
3 poke198,0:f1=0:f2=0
5 dim m0$(20),m1$(20),m2$(20)
6 dimm9$(20):sp$=" "
7 dimd$(22):fori=0to18:d$(i)="0":next
10 poke53280,0:poke53281,0:ad=36864
20 readx:fori=1tox:readm0$(i):next
21 readx:fori=1tox:readm1$(i):next
22 readx:fori=1tox:readm2$(i):next
29 readx:fori=1tox:readm9$(i):next
30 print"";
40 sysad,"[212][160][193][160][216][160] [160][193] [195][160][195] [207] [213] [206] [212][160][193][160][206] [212]","[198]orm 4684"
50 ifpeek(198)<>1thenend
55 sysad+15:getdv$:getme$:gethi$:gettx$
56 dv=asc(dv$):m=asc(me$)and15:h=asc(hi$)and15:tx=asc(tx$)and15
60 sysad+18:poke198,0:gosub9000
70 sysad+3,6+64,11,8,m,h,tx,m0$(1),m0$(2),m0$(3),m0$(4),m0$(5),m0$(6)
80 getk$:k$=str$(asc(k$)-48):k=val(k$)
85 ifk>3thensysad+18:poke781,21:sys59903
90 onkgoto 200,300,900,1080,2075,40
95 goto70
100 :
200 gosub9300
210 ifval(w$)=0then275
220 open15,dv,15,"io":w$="4684."+w$
225 open2,dv,2,"0:"+w$+",s,r"
230 input#15,e,e$,e1,e2
234 poke214,21:print:print" "
235 poke214,21:print:print"[196]isk [211]tatus:"e;e$:fori=1to2000:next
236 poke214,21:print:print" "
240 ifethenclose2:close15:print"[145][198]ile [206]ot [204]oaded":fori=1to2000:next:goto275
250 fori=0to18:input#2,d$(i):next
270 close2:close15
275 gosub9000:goto70
280 :
300 gosub9300:ifval(w$)=0then375
310 w$="4684."+w$
320 open15,dv,15,"s0:"+w$:close15
330 open15,dv,15,"io"
335 open2,dv,2,"0:"+w$+",s,w"
340 input#15,e,e$,e1,e2
344 poke214,21:print:print" "
345 poke214,21:print:print"[196]isk [211]tatus: "e;e$:fori=1to2000:next
346 poke214,21:print:print" "
350 ifethenclose2:close15:print"[145][198]ile [206]ot [211]aved":fori=1to2000:next:goto375
355 gosub400
360 fori=0to18:print#2,d$(i):next
370 close2:close15
375 gosub9000:goto70
390 :
400 ifval(d$(2))>val(d$(3))then410
405 fori=5to16:d$(i)="0":next:d$(18)="0":d$(4)="[211][212][207][208]":return
410 d$(4)="0"
412 d$(7)=str$(val(d$(5))-val(d$(6)))
415 d$(8)=d$(2):ifval(d$(2))>val(d$(7))thend$(8)=d$(7)
420 d$(9)=str$(val(d$(8))-val(d$(3)))
425 d$(10)=d$(9)
430 d$(11)="100":ifval(d$(11))>val(d$(10))thend$(11)=d$(10)
435 d$(12)=str$(val(d$(10))-val(d$(11)))
440 d$(13)=d$(12)
445 ifval(d$(14))>=val(d$(13))thend$(15)="[211][212][207][208]":return
450 d$(15)="0"
455 d$(16)=str$(val(d$(13))-val(d$(14)))
460 d$(18)=str$(val(d$(16))-val(d$(17))):ifval(d$(18))<0thend$(18)="0"
465 return
470 :
500 sysad+6,2:sysad+9,1
505 sys50176,1,3,38,20,tx,0
510 ky=peek(197)
515 ifky=3thensys51712,1,3,38,20,7:goto505
520 ifky=6thenopen15,dv,15,"s0:"+n$:close15:sysad+12,n$,1:goto505
530 ifky=5then poke147,0:sys57812n$,dv,1:sys62631:sysad+9,1:goto505
550 sysad+6,1:sysad+9,2:return
560 :
600 sysad+6,2:poke646,tx:print"[147]"tab(14)"*** [200][197][204][208] ***"
601 poke646,m
602 print"[176][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][192][192][174]";
603 fori=1to21:print"[221] [221]";:next
604 print"[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][192][192][189]";:poke646,tx
605 print" [208]ress [210][197][212][213][210][206]";:poke52346,tx
606 open2,dv,2,h$+",p,r":sys51968
610 poke198,0
615 getk$:ifk$<>chr$(13)then615
620 close2:sysad+9,2:return
625 :
900 gosub9400:ifw$<>"y"thengosub9000:goto70
905 poke214,22:print:print"[208]rinting... "
907 gosub400
910 open4,4,7
915 print#4,sp$;"[198]orm 4684 - [195]asualty/[212]heft"
920 print#4,sp$;"-------------------------------------"
925 fori=1to9:print#4,sp$;left$(m1$(i),27)+right$(sp$+d$(i),10):next:print#4
930 fori=1to9:print#4,sp$;left$(m2$(i),27)+right$(sp$+d$(i+9),10):next:print#4
960 print#4:close4:gosub9000:goto70
995 :
1000 sysad+3,13+64,1,7,m,h,tx,m1$(1),m1$(2),m1$(3),m1$(4),m1$(5),m1$(6),m1$(7),m1$(8),m1$(9),m1$(10),m1$(11),m1$(12),m1$(13)
1010 getk$:k$=str$(asc(k$)-48):k=val(k$)
1020 ifk=13thensysad+18:goto70
1025 ifk=12thenh$="4684.h1":gosub600:goto1000
1030 ifk=10thenn$="4684.n1":gosub500:goto1000
1035 ifk=11thengosub9500:goto1000
1040 ifk=4then1000
1041 ifk>6then1000
1045 ifk=1thengosub9350:d$(1)=w$:goto1080
1050 gosub9100:iflen(w$)=0then1000
1070 d$(k)=w$:gosub400
1080 fori=1to9:m1$(i)=left$(m1$(i),27)+right$(sp$+d$(i),10):next:gosub9000
1085 goto1000
1090 :
2000 sysad+3,13+64,1,7,m,h,tx,m2$(1),m2$(2),m2$(3),m2$(4),m2$(5),m2$(6),m2$(7),m2$(8),m2$(9),m2$(10),m2$(11),m2$(12),m2$(13)
2010 getk$:k$=str$(asc(k$)-48):k=val(k$)
2020 ifk=13thensysad+18:goto70
2025 ifk=12thenh$="4684.h2":gosub600:goto2000
2030 ifk=10thenn$="4684.n2":gosub500:goto2000
2035 ifk=11thengosub9500:goto2000
2045 ifk<>8then2000
2050 gosub9100:iflen(w$)=0then2000
2055 d$(k+9)=w$:gosub400
2075 fori=1to9
2080 m2$(i)=left$(m2$(i),27)+right$(sp$+d$(i+9),10):next
2085 goto2000
2090 :
9000 poke214,21:print:print"[176][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][192][192][174]";
9005 print"[221] [213]se [195]ursor [203]eys/[210][197][212][213][210][206] to select. [221]";
9010 print"[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][192][192]";:poke2023,125:poke56295,1
9015 return
9100 gosub9600:poke646,tx
9105 poke214,22:print:print"[197]nter: ";
9110 sys49152+3,tx,tx,9
9115 gosub9000:return
9200 poke214,21:print:print"[176][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][192][192][174]";
9205 print"[221] [208]ress [210][197][212][213][210][206] [221]";
9210 print"[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][192][192]";:poke2023,125:poke56295,1
9215 return
9300 gosub9600:poke646,tx
9305 poke214,22:print:print"[197]nter [217]ear: ";
9310 sys49152+3,tx,tx,4
9315 return
9320 :
9350 gosub9600:poke646,tx
9355 poke214,22:print:print"[197]nter: ";
9360 sys49152,tx,tx,10
9365 return
9400 gosub9600:poke646,tx
9405 poke214,22:print:print"[208]rinter [210]eady? ";
9410 sys49152,tx,tx,1
9415 return
9420 :
9500 sysad+18:poke646,m
9501 print""tab(9)"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
9502 printtab(9)"[221] [221]"
9503 printtab(9)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
9504 ac=0:ac$="0"
9505 ac$=right$(sp$+ac$,10):poke646,tx
9506 print""tab(17)ac$
9510 sysad+3,6+64,10,9,m+64,h,tx,m9$(1),m9$(2),m9$(3),m9$(4),m9$(5),m9$(6)
9520 getk$:k$=str$(asc(k$)-48):k=val(k$)
9525 ifk=6thensysad+18:return
9530 ifk=1thenac=0:goto9565
9535 gosub9100
9540 w=val(w$):ifw=0then9505
9545 ifk=2thenac=ac+w
9550 ifk=3thenac=ac-w
9555 ifk=4thenac=ac*w
9560 ifk=5thenac=ac/w
9565 ac$=str$(ac):goto9505
9570 :
9600 fori=217to242:pokei,peek(i)or128:next
9602 poke214,22:print:print" "
9605 return
9610 :
10000 open15,8,15,"s0:4684":close15:save"0:4684",8:end
10998 :
10999 rem menu0
11000 data 6
11001 data "[204]oad [198]ile "
11002 data "[211]ave [198]ile "
11003 data "[208]rint [198]ile "
11004 data "[204]ines 1-9 "
11005 data "[204]ines 10-18 "
11013 data "[205]ain [205]enu "
11014 :
11099 rem menu1
11100 data 13
11101 data " 1. [208]roperty 0"
11102 data " 2. [195]ost/basis of property 0"
11103 data " 3. [210]eimbursement 0"
11104 data " 4. [199]a