home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1988 August / 64er_Magazin_88-08_1988_Markt__Technik_de_Side_B.d64 / dump'1520.proc < prev    next >
Encoding:
Text File  |  1988-01-01  |  2.2 KB  |  120 lines
  1. 9000 //
  2. 9005 proc dump1520(reverse,color) closed
  3. 9010 dim d$ of 1
  4. 9015 dim mo$ of 1
  5. 9020 dim p$ of 1
  6. 9025 dim xc$ of 3
  7. 9030 dim yc$ of 4
  8. 9035 dim pos$ of 9
  9. 9040 dim endl$ of 3
  10. 9045 if reverse then
  11. 9050 d$:="m"; mo$:="d"
  12. 9055 else 
  13. 9060 d$:="d"; mo$:="m"
  14. 9065 endif 
  15. 9070 open file 1,"",unit 6,1,write
  16. 9075 open file 6,"",unit 6,0,write
  17. 9080 open file 2,"",unit 6,2,write
  18. 9085 open file 7,"",unit 6,7,write
  19. 9090 print file 2: chr$(color+ord("0")),
  20. 9095 //
  21. 9100 for i:=1 to 10 do
  22. 9105 print file 6: 
  23. 9110 endfor i
  24. 9115 print file 1: " m80 199"
  25. 9120 for y:=199 to 0 step -2 do
  26. 9125 yc$:=""
  27. 9130 strpp(yc$,y)
  28. 9135 yc$:=" "+yc$
  29. 9140 pos$:="m80"+yc$
  30. 9145 yy:=y
  31. 9150 z:=getcolor(0,yy)
  32. 9155 print file 1: pos$
  33. 9160 for i:=1 to 2 do
  34. 9165 if i=1 then
  35. 9170 ss:=0
  36. 9175 ff:=319
  37. 9180 sp:=1
  38. 9185 endl$:="399"
  39. 9190 else 
  40. 9195 ff:=0
  41. 9200 ss:=319
  42. 9205 sp:=-1
  43. 9210 endl$:="80"
  44. 9215 yy:=y-1
  45. 9220 yc$:=""
  46. 9225 strpp(yc$,yy)
  47. 9230 yc$:=" "+yc$
  48. 9235 pos$:="m"+"399"+yc$
  49. 9240 print file 1: pos$
  50. 9245 endif 
  51. 9250 for x:=ss to ff step sp do
  52. 9255 if getcolor(x,yy)<>z then
  53. 9260 case z of
  54. 9265 when 1
  55. 9270 p$:=mo$
  56. 9275 otherwise 
  57. 9280 p$:=d$
  58. 9285 endcase 
  59. 9290 xc$:=""
  60. 9295 xx:=x
  61. 9300 if i=2 then xx:=xx+1
  62. 9305 strpp(xc$,xx+80)
  63. 9310 pos$:=p$+xc$+yc$
  64. 9315 print file 1: pos$
  65. 9320 z:=getcolor(x,yy)
  66. 9325 endif 
  67. 9330 endfor x
  68. 9335 z:=getcolor(319,yy)
  69. 9340 if z<>1 then
  70. 9345 pos$:=d$+endl$+yc$
  71. 9350 print file 1: pos$
  72. 9355 endif 
  73. 9360 z:=getcolor(319,y-1)
  74. 9365 endfor i
  75. 9370 endfor y
  76. 9375 print file 1: "m"
  77. 9380 print file 6: chr$(13),chr$(13)
  78. 9385 print file 7: 
  79. 9390 close
  80. 9395 endproc dump1520
  81. 9400 //
  82. 9405 proc strpp(ref c$,n) closed
  83. 9410 dim t$ of 6
  84. 9415 n:=abs(n)
  85. 9420 d:=n mod 10
  86. 9425 t$:=t$+chr$(d+48)
  87. 9430 if d=n then
  88. 9435 c$:=c$+t$
  89. 9440 else 
  90. 9445 strpp(c$,(n-d)/10)
  91. 9450 c$:=c$+t$
  92. 9455 endif 
  93. 9460 endproc strpp
  94. 9465 //
  95. 9470 proc str(ref c$,n) closed
  96. 9475 dim t$ of 11, s$ of 1, dd$ of 5
  97. 9480 if n<0 then s$:="-"
  98. 9485 n:=abs(n)
  99. 9490 if (n div 1)<>n then
  100. 9495 f:=int((n*10000) mod 10000+.5)
  101. 9500 str(dd$,f)
  102. 9505 dd$:="."+dd$
  103. 9510 p:=len(dd$)
  104. 9515 while dd$(p)="0" and p>1 do
  105. 9520 dd$:=dd$(1:p-1)
  106. 9525 p:=p-1
  107. 9530 endwhile 
  108. 9535 n:=n div 1
  109. 9540 endif 
  110. 9545 d:=n mod 10
  111. 9550 t$:=t$+chr$(d+48)
  112. 9555 if d=n then
  113. 9560 c$:=c$+t$
  114. 9565 else 
  115. 9570 str(c$,(n-d)/10)
  116. 9575 c$:=c$+t$
  117. 9580 endif 
  118. 9585 c$:=s$+c$+dd$
  119. 9590 endproc str
  120.