home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 16 / 64er_Magazin_Sonderheft_16_19xx_Markt__Technik_de_Side_A.d64 / demo-karteiverw (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  362 lines
  1. 100 rem *******************************
  2. 110 rem *                             *
  3. 120 rem * ak-soft proudly presents :  *
  4. 130 rem *                             *
  5. 140 rem * > karteikarten-verwaltung < *
  6. 150 rem *                             *
  7. 160 rem *       programmed with       *
  8. 170 rem *                             *
  9. 180 rem *         t w m  v1.0         *
  10. 190 rem *                             *
  11. 200 rem *    by a.knuepfer            *
  12. 210 rem *       auf dem knuell 18     *
  13. 220 rem *       2056 glinde           *
  14. 230 rem *       tel. 040/710 80 06    *
  15. 240 rem *                             *
  16. 250 rem *******************************
  17. 260 :
  18. 296 :
  19. 297 rem -------------------------------
  20. 298 rem  initialisierung
  21. 299 :
  22. 300 if peek(32168)<>162 or peek(38168)<>150 then load "twm v1.0",8,1
  23. 310 sys 32168
  24. 320 :
  25. 330 (NULL) 0
  26. 350 poke 53280,0 :poke 53281,0 :poke 650,128
  27. 360 poke 40909,34 :rem finput# erkennt (auch) anfuehrungszeichen als stringende
  28. 370 print chr$(14)
  29. 396 :
  30. 397 rem -------------------------------
  31. 398 rem  titel
  32. 399 :
  33. 400 if peek(828)<>0 then 600
  34. 402 poke 828,1
  35. 405 (NULL)
  36. 410 (NULL) 4,0,"[193][203]-[211][207][198][212]"
  37. 420 (NULL) 6,"proudly presents"
  38. 430 (NULL) 8,"> [203][193][210][212][197][201][203][193][210][212][197][206] - [214][197][210][215][193][204][212][213][206][199] <"
  39. 440 (NULL) 11,"programmed with"
  40. 450 (NULL) 13,"[212] [215] [205] - [212][200][197] [215][201][206][196][207][215] [205][193][206][193][199][197][210] [214]1.0"
  41. 460 (NULL) 16,"by"
  42. 470 (NULL) 18,"[193].[203]nuepfer, [199]linde 1986"
  43. 480 :
  44. 500 f(0)=0 :f(1)=11 :f(2)=12 :f(3)=15 :f(4)=1 :rem graustufen
  45. 510 for z=0 to 24 :for f=0 to 4 :(NULL) f(f),z,0,z,39 :for h=1 to 30 :next h,f,z
  46. 520 for h=1 to 2000 :next
  47. 530 for f=4 to 0 step -1 :(NULL) f(f),4,4,18,34
  48. 540 for h=1 to 30 :next h,f
  49. 550 for h=1 to 1000 :next
  50. 596 :
  51. 597 rem -------------------------------
  52. 598 rem  hauptprogramm anspringen
  53. 599 :
  54. 600 goto 10000
  55. 992 :
  56. 993 :
  57. 994 rem ===============================
  58. 995 rem  kleinere unterprogramme
  59. 996 :
  60. 997 rem -------------------------------
  61. 998 rem  boxmenu anlegen
  62. 999 :
  63. 1000 (NULL) :z=0 :s=0
  64. 1010 for b=0 to bn
  65. 1020 (NULL) z,s,b(b),b$(b);
  66. 1030 s1=s+len(b$(b))-1
  67. 1040 (NULL) b(b),z,s,z,s1
  68. 1050 (NULL)b,z,s,z,s1,b(b)+128
  69. 1060 s=s1+1+t
  70. 1070 next b
  71. 1080 return
  72. 1096 :
  73. 1097 rem ------------------------------
  74. 1098 rem  datendiskette
  75. 1099 :
  76. 1100 (NULL)4,12,2,18,37,1 :(NULL)4,5,128 :(NULL)4
  77. 1110 (NULL) 1,5,"[194]itte [155] [196][193][212][197][206] - [196][201][211][203][197][212][212][197] "
  78. 1120 (NULL) 3,5,"ins [204]aufwerk einlegen !"
  79. 1130 return
  80. 1194 :
  81. 1195 rem ------------------------------
  82. 1196 rem  nicht ok / ok ?
  83. 1197 rem                ja   -> ok=1
  84. 1198 rem                nein -> ok=0
  85. 1199 :
  86. 1200 ok=1
  87. 1210 (NULL)100,20,19,24,39,1 :(NULL)100,14,128 :(NULL)100
  88. 1220 (NULL) 1,2,"[206][201][195][200][212] [207][203]"
  89. 1230 (NULL) 1,14,"[207][203]"
  90. 1240 (NULL)
  91. 1250 (NULL)0,1,1,1,10,1
  92. 1260 (NULL)1,1,12,1,17,1
  93. 1270 (NULL) "help boxmenu" :(NULL) ok
  94. 1280 (NULL) :(NULL)100
  95. 1290 return
  96. 1296 :
  97. 1297 rem ------------------------------
  98. 1298 rem  diskstatus-test
  99. 1299 :
  100. 1300 input#15,f1,ff$,ft,fs :if f1<2 then return
  101. 1310 printchr$(7);
  102. 1320 (NULL)100,8,2,16,37,1,0,"[196][201][211][203][197][212][212][197][206][198][197][200][204][197][210]" :(NULL)100,7,0 :(NULL)100
  103. 1330 f1$=usr("##")f1 :ft$=usr(ft) :fs$=usr(fs)
  104. 1340 (NULL) 1,1," "+f1$+","+ff$+","+ft$+","+fs$+" "
  105. 1350 (NULL) 3,7,"... mit  [210][197][212][213][210][206] [146] quittieren !"
  106. 1360 get w$ :if w$<>chr$(13) then 1360
  107. 1370 (NULL) :(NULL)100
  108. 1380 return
  109. 1396 :
  110. 1397 rem ------------------------------
  111. 1398 rem  window fuer datensatznr.
  112. 1399 :
  113. 1400 (NULL)7,10,7,16,33,1,0,he$ :(NULL)7,4,128 :(NULL)7
  114. 1410 return
  115. 1496 :
  116. 1497 rem ------------------------------
  117. 1498 rem  kartei-datensatz in maske
  118. 1499 :
  119. 1500 nr=peek(30964) :if nr<>0 then (NULL)0
  120. 1510 (NULL) 4,28,15,"[206]r."usr("###")i1;"[152]"usr("/###")n1;
  121. 1520 (NULL)10
  122. 1525 if i1=0 then (NULL) :goto 1540
  123. 1530 for i2=1 to n2 :(NULL)#(i2-1),a$(i1,i2) :next
  124. 1540 if nr<>10 then (NULL)nr
  125. 1550 return
  126. 1992 :
  127. 1993 :
  128. 1994 rem ==============================
  129. 1995 rem  groessere unterprogramme
  130. 1996 :
  131. 1997 rem ------------------------------
  132. 1998 rem  arbeitsbildschirm aufbauen
  133. 1999 :
  134. 2000 (NULL)
  135. 2010 (NULL) 0,1,15,"[203][193][210][212][197][201][203][193][210][212][197][206]-[214][197][210][215][193][204][212][213][206][199]"
  136. 2015 (NULL) 24,15,"     f5 [146] [200]ilfstexte    f6 [146] [200]ardcopy"
  137. 2020 :
  138. 2030 rem ----- haupt-boxmenu
  139. 2040 rem bereich festlegen, in dem sich der cursor bewegen darf:
  140. 2050 (NULL)1,2,1,2,25,0 :(NULL)1,15,0 :(NULL)1
  141. 2060 b$(0)=" [197][206][196][197] " :b(0)=7 :rem text/farbe
  142. 2070 b$(1)=" [204][207][193][196] " :b(1)=10
  143. 2080 b$(2)=" [197][196][201][212] " :b(2)=5
  144. 2090 b$(3)=" [211][193][214][197] " :b(3)=14
  145. 2100 t=0 :bn=3 :gosub 1000
  146. 2110 :
  147. 2120 rem ----- edit-boxmenu
  148. 2130 (NULL)2,22,1,22,39,0 :(NULL)2,15,0 :(NULL)2
  149. 2140 b$(0)="_"       :b(0)=7
  150. 2150 b$(1)="[193][197][206][196][197][210][206]" :b(1)=10
  151. 2160 b$(2)="[204][207][197][211][195][200]"  :b(2)=10
  152. 2170 b$(3)="<<"      :b(3)=15
  153. 2180 b$(4)="<"       :b(4)=15
  154. 2190 b$(5)=">"       :b(5)=15
  155. 2200 b$(6)=">>"      :b(6)=15
  156. 2210 b$(7)="[193][206][198][213][197][199]"  :b(7)=10
  157. 2220 b$(8)="[211][207][210][212]"    :b(8)=5
  158. 2230 t=1 :bn=8 :gosub 1000
  159. 2240 :
  160. 2250 rem ----- zeit-anzeige
  161. 2260 (NULL)3,0,30,2,39,1 :(NULL)3,12,128 :(NULL)3
  162. 2270 (NULL) "000000",1,31
  163. 2280 :
  164. 2290 rem ----- karteikarten-window
  165. 2300 (NULL)10,6,0,20,39,1 :(NULL)10,6,128 :(NULL)10
  166. 2310 :
  167. 2320 return
  168. 2396 :
  169. 2397 rem ------------------------------
  170. 2398 rem  allgemeines
  171. 2399 :
  172. 2400 open 15,8,15
  173. 2420 :
  174. 2430 rem ----- uhrzeit eingeben
  175. 2440 :
  176. 2450 (NULL)5,4,12,8,37,1 :(NULL)5,4,128 :(NULL)5
  177. 2455 (NULL) "help winput"
  178. 2460 (NULL) 1,1,4,"[218][197][201][212] ([200][200][205][205][211][211]) : ",n,6,15,tm$
  179. 2470 if len(tm$)<>6 then printchr$(7) :goto 2460
  180. 2480 (NULL) tm$
  181. 2490 (NULL) :(NULL)5
  182. 2500 return
  183. 2992 :
  184. 2993 :
  185. 2994 rem ==============================
  186. 2995 rem  hauptmenu-funktionen
  187. 2996 :
  188. 2997 rem ------------------------------
  189. 2998 rem  load
  190. 2999 :
  191. 3000 gosub 1100 :rem datendisk einlegen
  192. 3010 gosub 1200 :rem alles klar ?
  193. 3020 if ok=0 then (NULL) :(NULL)4 :return
  194. 3030 jn$="j"
  195. 3040 print "[147]"
  196. 3045 (NULL) "help winput"
  197. 3050 (NULL) 1,2,5,"[197]xistiert die [196]atei schon ? ",,"jn",1,15,jn$
  198. 3060 if jn$="n" then 3500
  199. 3070 :
  200. 3080 rem ----- existierende datei laden
  201. 3085 clr :hm=1 :open15,8,15 :dim d$(100)
  202. 3090 print"[147]" :(NULL) 1,"[197]inlesen des"
  203. 3100 (NULL) 3,"[196]isketten-[201]nhaltsverzeichnisses"
  204. 3110 :
  205. 3115 d=1
  206. 3120 open 1,8,0,"$" :gosub 1300 :if f1>1 then close1 :(NULL) :(NULL)4 :return
  207. 3130 n=0 :get#1,x$,x$
  208. 3140 get#1,x$,x$,x$,x$ :(NULL)1,x$
  209. 3150 if left$(x$,6)="blocks" then close1 :n=n-1 :goto 3190
  210. 3160 (NULL)1,x$ :d$(n)=x$ :(NULL)1,x$
  211. 3165 if d=1 and d$(n)="test" then d=n
  212. 3170 n=n+1 :goto 3140
  213. 3180 :
  214. 3190 if n>0 then 3210
  215. 3195 print"[147]"
  216. 3200 (NULL) 2,15," *** [198]alsche [196]iskette *** " :(NULL) "_",128+5 :goto 3040
  217. 3210 (NULL)6,4,18,22,37,1,0,"[203]arteiname" :(NULL)6,2,128 :(NULL)6
  218. 3220 (NULL) "help menu" :(NULL) d$(1),d$(n),0,1,10,1,d
  219. 3225 if d=0 then (NULL) :(NULL)6 :goto 3040
  220. 3230 :
  221. 3240 he$="[204]aden" :gosub 1400
  222. 3250 (NULL) 1,"[197]ingabemaske"
  223. 3260 dn$=d$(d)
  224. 3270 (NULL) dn$+chr$(160)+"m" :gosub 1300 :if f1>1 then 3360
  225. 3280 (NULL)
  226. 3290 open 1,8,2,dn$+chr$(160)+"d,s,r" :gosub 1300 :if f1>1 then 3360
  227. 3300 (NULL)1,x1$,x2$ :n1=val(x1$) :n2=val(x2$)
  228. 3310 dim a$(200,n2) :if n1=0 then i1=0 :goto 3355
  229. 3320 for i1=1 to n1 :i$=usr("###")i1 :(NULL) 1,"[206]r."+i$
  230. 3330 for i2=1 to n2
  231. 3340 (NULL)1,x$ :a$(i1,i2)=x$
  232. 3350 next i2,i1
  233. 3352 i1=1
  234. 3355 ff=1
  235. 3360 close1
  236. 3370 (NULL) :(NULL)7 :(NULL) :(NULL)6
  237. 3380 (NULL)10 :(NULL)4
  238. 3390 if n1>0 then gosub 1500
  239. 3400 goto 10330
  240. 3499 :
  241. 3500 rem ----- neue datei anlegen
  242. 3505 clr :hm=1 :open15,8,15
  243. 3510 dn$="test" :(NULL) 3,2,5,"[206]ame der [196]atei : ",a,14,15,dn$
  244. 3520 (NULL) :(NULL)4
  245. 3550 print"[147]"
  246. 3560 (NULL) "help maskdef 1" :(NULL)
  247. 3570 gosub 1200 :if ok=0 then 3560
  248. 3580 (NULL)
  249. 3590 (NULL)
  250. 3600 n2=(NULL)(0) :poke 829,n2
  251. 3610 (NULL) "@:"+dn$+chr$(160)+"m"
  252. 3620 open 1,8,2,"@:"+dn$+chr$(160)+"d,s,w" :gosub 1300
  253. 3625 if f1>1 then close 1 :goto 3670
  254. 3630 print#1,0 :print#1,n2
  255. 3640 close 1
  256. 3650 ff=1 :i1=1
  257. 3660 dim a$(200,n2)
  258. 3680 goto 10330
  259. 3996 :
  260. 3997 rem ------------------------------
  261. 3998 rem  edit
  262. 3999 :
  263. 4000 bb=5 :if n1=0 then bb=7
  264. 4020 (NULL)2 :(NULL) "help editmenu" :(NULL) bb :(NULL)10
  265. 4030 if bb=0 then return
  266. 4040 if n1=0 and bb<>7 then printchr$(7); :goto 4020
  267. 4050 on bb gosub 4220,4100,4310,4300,4400,4410,4200,4500
  268. 4060 gosub 1500 :goto 4020
  269. 4098 :
  270. 4099 rem ----- loeschen
  271. 4100 gosub 1200 :if ok=0 then return
  272. 4110 n1=n1-1
  273. 4120 for i=i1 to n :for i2=1 to n2 :a$(i,i2)=a$(i+1,i2) :next i2,i
  274. 4130 if i1>n1 then i1=n1
  275. 4140 return
  276. 4198 :
  277. 4199 rem ----- anfuegen
  278. 4200 n1=n1+1 :i1=n1
  279. 4210 (NULL)
  280. 4220 (NULL) "help medit" :(NULL)
  281. 4230 for i2=1 to n2 :(NULL)#(i2-1),a$(i1,i2) :next
  282. 4240 return
  283. 4298 :
  284. 4299 rem ----- "<", "<<"
  285. 4300 i1=i1-1 :goto 4320
  286. 4310 i1=i1-5
  287. 4320 if i1<1 then i1=1 :printchr$(7);
  288. 4330 return
  289. 4398 :
  290. 4399 rem ----- ">", ">>"
  291. 4400 i1=i1+1 :goto 4420
  292. 4410 i1=i1+5
  293. 4420 if i1>n1 then i1=n1 :printchr$(7);
  294. 4430 return
  295. 4498 :
  296. 4499 rem ----- alphabetisch sortieren
  297. 4500 he$="[211]ortieren" :gosub 1400
  298. 4510 m=n1
  299. 4520 m=int(m/2) :m$=usr("###")m :(NULL) 1,"[206]r."+m$ :if m=0 then 4650
  300. 4530 k=n1-m :j=1
  301. 4540 i=j
  302. 4550 for i2=1 to n2
  303. 4560 if a$(i,i2)<a$(i+m,i2) then i2=n2 :next :goto 4630
  304. 4570 if a$(i,i2)>a$(i+m,i2) then i2=n2 :next :goto 4600
  305. 4580 next i2
  306. 4590 goto 4630
  307. 4600 for i2=1 to n2 :t$=a$(i,i2) :a$(i,i2)=a$(i+m,i2) :a$(i+m,i2)=t$ :next i2
  308. 4610 i=i-1
  309. 4620 if i>=1 then 4550
  310. 4630 j=j+1 :if j>k then 4520
  311. 4640 goto 4540
  312. 4650 (NULL) :(NULL)7
  313. 4660 i1=1
  314. 4670 return
  315. 4996 :
  316. 4997 rem ------------------------------
  317. 4998 rem  save
  318. 4999 :
  319. 5000 gosub 1200 :if ok=0 then return
  320. 5010 he$="[211]peichern" :gosub 1400
  321. 5020 open 1,8,2,"@:"+dn$+chr$(160)+"d,s,w"
  322. 5030 gosub 1300 :if f1>2 then 5070
  323. 5040 print#1,n1 :print#1,n2
  324. 5045 if n1=0 then 5070
  325. 5050 for i=1 to n1 :i$=usr("###")i :(NULL) 1,"[206]r."+i$
  326. 5060 for i2=1 to n2 :print#1,a$(i,i2) :next i2,i
  327. 5070 close1
  328. 5080 (NULL) :(NULL)7
  329. 5090 return
  330. 9996 :
  331. 9997 rem ==============================
  332. 9998 rem  h a u p t p r o g r a m m
  333. 9999 :
  334. 10000 gosub 2000 :rem arbeitsbildschirm aufbauen
  335. 10010 gosub 2400 :rem allgemeines
  336. 10020 :
  337. 10030 hm=1 :rem beim ersten mal 'load' waehlen
  338. 10096 :
  339. 10097 rem -----------------------------
  340. 10098 rem  hauptmenu
  341. 10099 :
  342. 10100 (NULL)1
  343. 10110 (NULL) "help hauptmenu" :(NULL) hm
  344. 10120 if hm > 0 then 10200
  345. 10130 :
  346. 10140 rem ----- ende
  347. 10150 ok=0 :gosub 1210 :if ok=0 then 10110
  348. 10160 print"[147][212]schuess !"
  349. 10170 end
  350. 10198 :
  351. 10199 rem ----- load-abfrage, beim ersten mal m u s s 'load' gewaehlt werden !
  352. 10200 if ff=0 and hm<>1 then hm=1 :printchr$(7); :goto 10110
  353. 10299 :
  354. 10300 rem ----- funktionen anspringen
  355. 10310 (NULL)10
  356. 10320 on hm gosub 3000,4000,5000
  357. 10330 (NULL)0
  358. 10340 if ff=0 then 10100
  359. 10350 if hm=1 then (NULL) 4 :(NULL) 4,1,12,"[203]artei [155]'";dn$;"'"
  360. 10360 gosub 1500
  361. 10370 goto 10100
  362.