home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / c64 / diskutil / transfer / cp.prg (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1996-02-17  |  4.5 KB  |  148 lines
  1. 10 rem ****************************
  2. 20 rem *                          *
  3. 30 rem *  copy d64 image to 1541  *
  4. 40 rem *                          *
  5. 50 rem *  for the 1571 and c64    *
  6. 60 rem *   version 1.0  3/28/95   *
  7. 70 rem *                          *
  8. 80 rem *       k. bradley         *
  9. 90 rem *                          *
  10. 100 rem ***************************
  11. 110 fori=49152to49152+127:ready:pokei,y:next
  12. 130 poke51,0:poke52,32:poke55,0:poke56,32:clr:rem top of memory $2000
  13. 140 dimrf(5),wf(5)
  14. 150 mb=8192: rem $2000
  15. 160 nu=49189:lo=49187:hi=49188:re=49152:wr=49152+64
  16. 170 poke53280,0:poke53281,0:print"[147]"
  17. 180 input"file to copy";n$
  18. 190 print"verify [y/n]?  ":poke198,0:wait198,1:geta$:ve=0:ifa$="y"thenve=1
  19. 200 rem read directory track to find
  20. 210 rem the start track and sector of
  21. 220 rem the file to copy
  22. 230 t=18:s=1:fl=0
  23. 240 open15,8,15
  24. 250 print#15,"u0>m1":gosub1240
  25. 260 open5,8,5,"#": rem direct access
  26. 270 print#15,"u1";5;0;t;s: rem read t,s
  27. 280 gosub1240
  28. 290 pokenu,0
  29. 300 pokehi,int(mb/256):pokelo,mb-256*int(mb/256):rem hi,low
  30. 310 sysre: rem read 256 bytes
  31. 320 ifpeek(hi)<>int(mb/256)thenprint"error from sys49152!":gosub1240
  32. 330 rem we now have a directory listing
  33. 340 tn=peek(mb): rem next directory track
  34. 350 sn=peek(mb+1): rem next sector
  35. 360 curblock=mb+2:nblocks=8
  36. 370 if tn=0 then nblocks=(sn-2)/30:
  37. 380 for i=1tonblocks
  38. 390 fi=peek(curblock)
  39. 400 if fi=0 goto 470
  40. 410 ts=peek(curblock+1):ss=peek(curblock+2)
  41. 420 na$=""
  42. 430 forq=3to18:a$=chr$(peek(curblock+q)):ifa$<>chr$(160)thenna$=na$+a$
  43. 440 next q
  44. 450 print"looking at ";na$;" to ";n$
  45. 460 ifna$=n$ then t=ts:s=ss:goto520
  46. 470 curblock = curblock+32
  47. 480 next i
  48. 490 t=tn: s=sn: poke198,0:geta$
  49. 500 if t=0 thenprint"can't find disk image: quitting.":close5:close15:end
  50. 510 goto270
  51. 520 rem t=start track, s=start sector
  52. 530 nt=t:ns=s
  53. 540 ub=0:tm=0:vb=0
  54. 550 rf(1)=t:rf(2)=s:rf(3)=0:wf(1)=1:wf(2)=0
  55. 560 mb=8192:me=40960:ms=mb:om=mb:         rem $2000 - $a000
  56. 570 mi=mb
  57. 580 if vb=0thengosub710
  58. 590 pokenu,rf(4)-rf(3)
  59. 600 if me-mi < 254 then pokenu,me-mi
  60. 610 pokehi,int(mi/256):pokelo,mi-256*int(mi/256):rem hi,low
  61. 620 sysre:rf(3)=rf(3)+peek(nu)
  62. 630 ifpeek(hi)<>int(mi/256)thenprint"error from sys49152!":gosub1240
  63. 640 if rf(3)=rf(4) then vb=0
  64. 650 mi=mi+peek(nu):if mi<methengoto580
  65. 660 gosub830
  66. 670 ifwf(1)=36 then close5:close15:end
  67. 680 rem we're not done reading. loop back
  68. 690 goto 570
  69. 700 rem we now need to update the rf info
  70. 710 rem read new t&s
  71. 720 if nt=0 and rf(3)=rf(4) then gosub830:close15:close5:end
  72. 730 rf(1)=nt:rf(2)=ns:rf(3)=0
  73. 740 print#15,"u1";5;0;rf(1);rf(2): rem read t,s
  74. 750 gosub1240
  75. 760 get#5,a$:ifa$=""thena$=chr$(0)
  76. 770 nt=asc(a$):get#5,a$:ifa$=""thena$=chr$(0)
  77. 780 ns=asc(a$):rf(3)=2:rf(4)=256
  78. 790 if nt=0 then rf(4)=ns
  79. 800 print"[147]";int((mi-ms)/1024*100)/100;"kb out of 32 kb"
  80. 810 om=mi
  81. 820 vb=1:return
  82. 830 print"[147]dumping memory."
  83. 840 rb=ms:print"dumping ";(mi-rb)/1024;"kb of memory."
  84. 850 close15:close5
  85. 860 print"please insert destination disk"
  86. 870 print"press any key to continue."
  87. 880 poke198,0
  88. 890 wait198,1:geta$
  89. 900 open15,8,15,"u0>m1":close15
  90. 910 open15,8,15:open5,8,5,"#"
  91. 920 vf(1)=wf(1):vf(2)=wf(2)
  92. 930 wt=wf(1):ws=wf(2)
  93. 940 print"[147]writing to ";str$(wt);",";str$(ws);chr$(13);""
  94. 950 print(rb-ms)/1024;" kb written out of ";(mi-ms)/1024;" kb"
  95. 960 print#15,"b-p";5;0:rem reset buffer pointer
  96. 970 pokenu,0:pokehi,int(rb/256):pokelo,rb-peek(hi)*256:syswr
  97. 980 print#15,"u2";5;0;wt;ws
  98. 990 ifpeek(hi)<>int(rb/256)thenprint"error";peek(hi),peek(lo):gosub1240:stop
  99. 1000 gosub1240
  100. 1010 wf(2)=wf(2)+1:ws=ws+1
  101. 1020 ifwt>30 andwt<=35 and ws=17 then goto1090
  102. 1030 ifwt>24 andwt<=30 and ws=18 then goto1090
  103. 1040 ifwt>17 andwt<=24 and ws=19 then goto1090
  104. 1050 ifwt>0  andwt<=17 and ws=21 then goto1090
  105. 1060 ifwt=36 then goto1110
  106. 1070 rb=rb+256:ifrb=me then goto1110
  107. 1080 goto930
  108. 1090 wf(1)=wf(1)+1:wt=wt+1:wf(2)=0:goto1060
  109. 1100 ifve=1thengosub1270
  110. 1110 close5:close15
  111. 1130 print"please insert source disk."
  112. 1140 print"press any key to continue."
  113. 1150 poke198,0:rem empty keyboard buff
  114. 1160 wait198,1:geta$
  115. 1170 rem return read pointer to correct spot
  116. 1180 open15,8,15
  117. 1190 print#15,"u0>m1":gosub1240
  118. 1200 open5,8,5,"#"
  119. 1210 print#15,"u1";5;0;rf(1);rf(2)
  120. 1220 print#15,"b-p";5;rf(3): rem reset buffer pointer to correct spot
  121. 1230 return
  122. 1240 input#15,en,em$,et,es
  123. 1250 if en<20thenreturn
  124. 1260 printen,em$,et,es:stop
  125. 1270 rem verify section
  126. 1280 pokehi,int((49152+128)/256):pokelo,(49152+128)-peek(hi)*256:pokenu,0
  127. 1290 forrb=mbtomistep256
  128. 1300 print#15,"u1";5;0;vf(1);vf(2):sys49152
  129. 1310 ifvf(1)>30 andvf(1)<=35 and vf(2)=17 then goto1370
  130. 1320 ifvf(1)>24 andvf(1)<=30 and vf(2)=18 then goto1370
  131. 1330 ifvf(1)>17 andvf(1)<=24 and vf(2)=19 then goto1370
  132. 1340 ifvf(1)>0  andvf(1)<=17 and vf(2)=21 then goto1370
  133. 1350 ifvf(1)=36 then return
  134. 1360 next rb:return
  135. 1370 vf(1)=vf(1)+1:vf(2)=0:goto1360
  136. 1380 data173,35,192,133,251,173,36,192
  137. 1390 data133,252,160,0,162,5,24,32,198,255
  138. 1400 data176,79,24,32,207,255,176,73,145,251,200,204,37,192
  139. 1410 data208,242,96,0,0,0,67,198,140,68
  140. 1420 data198,96,32,29,192,186,189,1,1
  141. 1430 data201,140,208,7,189,2,1,201,164,240,15,172,68
  142. 1440 data173,35,192,133,251,173,36,192
  143. 1450 data133,252,160,0,162,5,24,32,201,255
  144. 1460 data176,19,24,177,251,32,210,255
  145. 1470 data176,20,200,204,37,192
  146. 1480 data208,242,96,141,36,192,96,141,36,192,169,1,141,35,192,96,141
  147. 1490 data36,192,169,2,141,35,192,96,0,0,0,0,0,0,0,0
  148.