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