home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / sh1x / sh16a.d64 / demo-karteiverw (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  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.