home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / demodisks / drives / 1581-demo.lzh / backup128-1581 (.txt) < prev    next >
Commodore BASIC  |  1994-10-19  |  4KB  |  93 lines
  1. 100 f=abs(peek(65533)=255):remf=0if 64
  2. 105 iff=1thenpoke48,4:poke47,0:clr
  3. 110 sys10246:r$="try"
  4. 115 poke53281,0:poke53280,0
  5. 120 wd=0:ps=0:bl$="                                     "
  6. 125 bl$=bl$+"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]":d$=""
  7. 130 l2$="[155][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":zz=8:px=57093:pokepx,0:if(peek(px)<>0)then145
  8. 135 pokepx,255:if(peek(px)<>255)then145
  9. 140 zz=2:if((peek(px-5)and16)=0)thenzz=4
  10. 145 nd=0:u=8:gosub415
  11. 150 u=9:gosub415:ifnd=2then165
  12. 155 u=10:gosub415:ifnd=2then165
  13. 160 u=11:gosub415
  14. 165 u=su:ap$=right$(str$(zz),2)+" passes   ":ifnd=2thenap$=" one pass   "
  15. 170 print"[147]"spc(7)l2$:printspc(7)"[159]  c128 backup 1581 disk  ":printspc(7)l2$
  16. 175 print"[159] to avoid mistakes, slide the write "
  17. 180 print" protect tab on the right side of   "
  18. 185 print" your original disk into the open   "
  19. 190 print" position.  it will take"ap$
  20. 195 print" to backup the whole disk.          "
  21. 200 ln$="  "+l2$+"[192][192][192][192][192][192][192][192][192][192][192]":u$="[145][145][145][145][145][145][145][145]"
  22. 205 print""ln$:printspc(2)"[159] instructions:":println$""d$
  23. 210 uu=1:ifu>9thenuu=2
  24. 215 ifpeek((NULL)("280c"))<>0then305
  25. 220 if nd=0 then305
  26. 225 ifnd=2then460
  27. 230 println$:print"   [159]unit:"u spc(uu)"[159]  pass: 1   [159]r to restart":println$"[145][145][145][145]"u$
  28. 235 gosub450:poke(NULL)("2811"),u:gosub315:sys(NULL)("2800")
  29. 240 gosub400:ifa<>0then380
  30. 245 gosub315
  31. 250 sys(NULL)("2803")
  32. 255 gosub400:ifa<>0then380
  33. 260 forpx=0tozz-2
  34. 265 gosub315:sys(NULL)("2800")
  35. 270 gosub400:ifa<>0then380
  36. 275 gosub315:sys(NULL)("2803")
  37. 280 gosub400:ifa<>0then380
  38. 285 nextpx
  39. 290 open15,u,15,"i0":close15
  40. 295 print""d$d$d$:gosub410:printspc(13)"all done.":r$="run":goto385
  41. 300 poke48,4:clr:end
  42. 305 print""d$d$d$:gosub410:printspc(9)"sorry, this runs on a"
  43. 310 printspc(8)"c128 with 1581 only.":goto385
  44. 315 if(ps>1)and((psand1)=0)thengosub405
  45. 320 ap$="writ":dp$="destination":ps=ps+1
  46. 325 if(psand1)=1thendp$="original":ap$="read"
  47. 330 ag$=" again,":ifps<3thenag$=","
  48. 335 ifwd=0then ag$=","
  49. 345 ifpeek(11226)<>0then360
  50. 350 if(ap$="writ")then printspc(7)"empty buffer...":return
  51. 355 ifps>1thenprintspc(7)"still "ap$"ing the":printspc(7)dp$" disk...":return
  52. 360 printspc(7)"insert "dp$" disk"ag$
  53. 361 printspc(7)"press any key when ready."
  54. 365 get(NULL)a$:ifa$="r"thenclr:goto395
  55. 370 if(wd=0 and ap$="writ")thengosub435:wd=1
  56. 375 printspc(7)ap$"ing...":return
  57. 380 print""d$d$d$:gosub410:printspc(11)"sorry, disk error"
  58. 385 print:printspc(7)"press q to quit; or press":printspc(7)"any other key to "r$" again."
  59. 390 get(NULL)a$:ifa$="q"thenprint"[147]":goto300
  60. 395 poke48,4:poke50,4:poke52,4:clr:run
  61. 400 open15,u,15:input#15,a,b$,c,d:close15
  62. 401 ifpeek((NULL)("280e"))<>0thena=78:b$="backup error"
  63. 402 return
  64. 405 print""spc(19)ps/2+1"[145][145][145]"
  65. 410 printu$;:forx=1to8:printbl$"";:nextx:print"[145]"u$:return
  66. 415 b$="":(NULL)420:open15,u,15:print#15,"m-r"chr$(198)chr$(229)chr$(1):get#15,b$
  67. 420 close15:ifasc(b$)<>255then430
  68. 425 nd=nd+1:du=u:ifnd=1thensu=u
  69. 430 return
  70. 435 open15,u,15,"i0":input#15,a,b$,c,d:close15:ifa<20thenreturn
  71. 440 ifwd=0thenap$="formatt":gosub375:print"[145][145]"
  72. 441 (NULL)"tem,"+id$,u(u):ap$="writ":return
  73. 450 open2,u,0,"$0:":forx=1to26:get#2,a$:next:get#2,a$,b$:id$=a$+b$:close2:return
  74. 455 rem--------
  75. 460 println$:print"  [159]unit:"su"[159]to"du"[159] pass: 1  [159]r to restart":println$"[145][145][145][145]"u$
  76. 465 if(NULL)(2)>4 then (NULL)%:(NULL):(NULL)&:(NULL)0
  77. 470 poke(NULL)("281f"),0:wd=1
  78. 475 poke(NULL)("2820"),1
  79. 480 printspc(7)"insert the original disk in"
  80. 485 printspc(7)"unit"u"[157].  put the destination"
  81. 490 printspc(7)"disk in unit"du"[157]."
  82. 495 ap$="work":print:gosub361:print
  83. 500 gosub450:u=du:gosub435
  84. 505 open 8,su,15,"i0":gosub530:ifa<>0thenclose8:goto380
  85. 506 open9,du,15:gosub535:ifa<>0thenclose9:close8:goto380
  86. 510 sys(NULL)("2809")
  87. 515 x=peek((NULL)("2810")):y=peek((NULL)("280e")):z=peek((NULL)("280f")):y=z*256+y
  88. 520 ifx>128thenx=x-128:ify<>0thenclose8:close9:goto380
  89. 525 close9:close8:open9,du,15,"i0":close9:goto295
  90. 530 input#8,a,b$,c,d:return
  91. 535 input#9,a,a$,b$,c$:return
  92. 540 "##############################"
  93.