home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 33 / 64er_Magazin_Sonderheft_33_19xx_Markt__Technik_de_Side_A.d64 / obj.kompaktor (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  2KB  |  89 lines
  1. 1000 rem *********************************
  2. 1010 rem *                               *
  3. 1020 rem *   ped daten kompressor fuer   *
  4. 1030 rem *    files die zu gross sind    *
  5. 1040 rem *  und nicht mehr in ped selbst *
  6. 1050 rem *   komprimiert werden koennen  *
  7. 1060 rem *                               *
  8. 1070 rem *********************************
  9. 1080 open14,8,15
  10. 1090 input"[147]name des zu komprimierenden files ";n$
  11. 1100 open1,8,2,n$+",s,r"
  12. 1110 gosub1780:iff<>0then1090
  13. 1120 input#1,k:input#1,e
  14. 1130 dimx(e+2),y(e+2),z(e+2)
  15. 1140 dimxn(e+2),yn(e+2),zn(e+2)
  16. 1150 dimp1%(k+1),p2%(k+1)
  17. 1160 forn=1tok+1
  18. 1170 input#1,p1%(n):input#1,p2%(n)
  19. 1180 next
  20. 1190 fori=1toe+1
  21. 1200 input#1,x(i):input#1,y(i):input#1,z(i):input#1,n
  22. 1210 next
  23. 1220 close1
  24. 1230 gosub1780:iff<>0then1090
  25. 1240 print"[147]";e+1;k+1
  26. 1250 print"doppelpunkte"
  27. 1260 forn=1toe+1
  28. 1270 print"";n
  29. 1280 xn(n)=x(n):yn(n)=y(n):zn(n)=z(n)
  30. 1290 ifx=-9999then1330
  31. 1300 fors=n+1toe+1
  32. 1310 if(x(n)=x(s))thenif(y(n)=y(s))thenif(z(n)=z(s))thenx(s)=-9999:y(s)=n:z(s)=0
  33. 1320 nexts
  34. 1330 nextn
  35. 1340 forn=1tok+1
  36. 1350 ifx(p1%(n))=-9999thenp1%(n)=int(yn(p1%(n)))
  37. 1360 ifx(p2%(n))=-9999thenp2%(n)=int(yn(p2%(n)))
  38. 1370 next
  39. 1380 print"[147]doppellinien"
  40. 1390 forn=1tok
  41. 1400 print"";n
  42. 1410 fors=n+1tok+1
  43. 1420 if(p1%(n)=p1%(s))and(p2%(n)=p2%(s))thenp1%(s)=-1:p2%(s)=-1
  44. 1430 if(p1%(n)=p2%(s))and(p2%(n)=p1%(s))thenp1%(s)=-1:p2%(s)=-1
  45. 1440 next
  46. 1450 next
  47. 1460 print"[147]neue punkte und kantenanzahl ermitteln"
  48. 1470 en=-1
  49. 1480 fori=1toe+1
  50. 1490 ifxn(i)<>-9999thenen=en+1
  51. 1500 next
  52. 1510 kn=-1
  53. 1520 fori=1tok+1
  54. 1530 ifp1%(i)<>-1thenkn=kn+1
  55. 1540 next
  56. 1550 print"[147]neues file speichern":print
  57. 1560 print:print"neue ecken und kanten anzahl :";en;kn
  58. 1570 ifen<=320orkn<=640then1630
  59. 1580 print"file noch zu gross fuer ped"
  60. 1590 print"a[146]brechen oder t[146]rotzdem speichern"
  61. 1600 poke198,0:wait198,1:getg$
  62. 1610 ifg$="a"thenclose14:print"[147]":end
  63. 1620 ifg$<>"t"then1600
  64. 1630 print:print"gleichnamiges file wird ueberschrieben":print:print
  65. 1640 input"filename";n$
  66. 1650 open1,8,2,"@:"+n$+",s,w"
  67. 1660 gosub1780:iff<>0then1650
  68. 1670 print#1,kn:print#1,en
  69. 1680 fori=1tok+1
  70. 1690 ifp1%(i)<>-1thenprint#1,p1%(i):print#1,p2%(i)
  71. 1700 next
  72. 1710 fori=1toe+1
  73. 1720 ifxn(i)<>-9999thenprint#1,xn(i):print#1,yn(i):print#1,zn(i):print#1,i
  74. 1730 next
  75. 1740 close1
  76. 1750 gosub1780:iff<>0then1650
  77. 1760 close14:end
  78. 1770 rem floppyfehlerkanal
  79. 1780 input#14,f,f$,f1,f2
  80. 1790 iff=0thenreturn
  81. 1800 close1
  82. 1810 print"[147]floppyfehler:"
  83. 1820 print""f;f$;f1;f2
  84. 1830 print"nochmal ? (j/n)"
  85. 1840 poke198,0:wait198,1:getg$
  86. 1850 ifg$="j"thenreturn
  87. 1860 ifg$<>"n"then1840
  88. 1870 print"[147]":close14:end
  89.