home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1993 October / 64er_Magazin_93-10_1993_Markt__Technik_de_Side_A.d64 / apfel.src (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  212 lines
  1. 5 poke56,96:clr
  2. 10 sys36864
  3. 20 .opt oo
  4. 30 *= $c000
  5. 100 av =249 ; grafikzeiger
  6. 102 xc =20  ; x-koordinate
  7. 104 vic =$d000 ; videochip
  8. 106 strout =$ab1e ; text ausgeben
  9. 108 bsin =$ffcf
  10. 110 buffer =820 ; puffer fuer zahleneingabe
  11. 112 txtptr =$7a ; pufferzeiger
  12. 114 chr(NULL)t =121 ; zeichen holen
  13. 116 ascfloat =$bcf3 ; ascii -> fac
  14. 118 round =$bc1b ; fac ggf. runden
  15. 120 facmem =$bbd4 ; fac speichern
  16. 122 memfac =$bba2 ; fac laden
  17. 124 integer =$b7f7 ; fac -> integer
  18. 126 memplus =$b867 ; fac = fac + konst
  19. 128 plus =$b86a ; fac = fac + arg
  20. 130 memmult =$ba28 ; fac = fac * konst
  21. 132 memmin =$b850 ; fac = konst - fac
  22. 134 facarg =$bc0c ; arg = fac
  23. 136 exp =$61 ; fac-exponent
  24. 138 vergleich =$bc5b ; vgl. fac - speicher
  25. 140 memdiv =$bb0f ; fac = konst/fac
  26. 142 return =$aad7 ; crlf
  27. 144 delay =$eeb3 ; wartet ca. 1 ms
  28. 900 ; apfelmaennchen ******************
  29. 902 ; von nikolaus heusler
  30. 904 ;     zwengauerweg 18
  31. 906 ;     81479 muenchen
  32. 908 ; (c) 6.93
  33. 950 ; hauptprogramm *******************
  34. 952 jsr para
  35. 954 jsr on
  36. 956 jsr apple
  37. 958 ldx #0:stx 198
  38. 960 fl1 lda color,x:sta vic+32:ldy #40
  39. 962 fl2 lda 198:bne end:jsr delay:dey:bne fl2
  40. 964 fl3 lda vic+17:bmi fl3:lda vic+18:cmp #3:bcs fl3
  41. 966 dex:bpl fl1:ldx #15:bne fl1
  42. 968 end jsr off:lda #0:sta 198:rts
  43. 990 color .byt 0,0,0,11,11,12,15,15,1,1,1,15,15,12,11,11
  44. 1000 ; variablenbereich ***************
  45. 1002 og brk:brk:brk:brk:brk ; obere grenze
  46. 1004 ug brk:brk:brk:brk:brk ; untere grenze
  47. 1006 lg brk:brk:brk:brk:brk ; linke grenze
  48. 1008 rg brk:brk:brk:brk:brk ; rechte grenze
  49. 1012 iz brk ; iterationszahl
  50. 1014 sr brk:brk:brk:brk:brk ; s - realteil
  51. 1016 si brk:brk:brk:brk:brk ; s - imaginaerteil
  52. 1018 cr brk:brk:brk:brk:brk ; c - realteil
  53. 1020 ci brk:brk:brk:brk:brk ; c - imaginaerteil
  54. 1022 i brk ; interationsschritt
  55. 1024 sr2 brk:brk:brk:brk:brk ; s - realteil (neu)
  56. 1026 aw brk:brk:brk:brk:brk ; betrag von s
  57. 1028 mx brk:brk:brk:brk:brk ; x - multiplikator
  58. 1030 my brk:brk:brk:brk:brk ; y - multiplikator
  59. 1032 vx brk:brk:brk:brk:brk ; x - schrittweite
  60. 1034 vy brk:brk:brk:brk:brk ; y - schrittweite
  61. 1036 rx brk:brk:brk:brk:brk ; x - aufloesung
  62. 1038 ry brk:brk:brk:brk:brk ; y - aufloesung
  63. 1040 bx brk:brk:brk:brk:brk ; x - groesse
  64. 1042 by brk:brk:brk:brk:brk ; y - groesse
  65. 2000 ; apfelmaennchen zeichnen ********
  66. 2002 apple ldx #4
  67. 2003 ; cr = lg
  68. 2004 ap1 lda lg,x:sta cr,x:dex:bpl ap1
  69. 2006 ; haupt-zeilen-schleife **********
  70. 2008 ap2 ldx #4
  71. 2009 ; ci = og
  72. 2010 ap3 lda og,x:sta ci,x:dex:bpl ap3
  73. 2012 ; haupt-spaltenschleife **********
  74. 2014 ap4 ldx #9:lda #0
  75. 2015 ; sr = 0, si = 0
  76. 2016 ap5 sta sr,x:dex:bpl ap5:sta i
  77. 2020 ; iterations-schleife ************
  78. 2022 ; sr2 = sr*sr - si*si + cr
  79. 2024 ap7 lda #<sr:ldy #>sr:jsr memfac:lda #<sr:ldy #>sr:jsr memmult
  80. 2026 ldx #<sr2:ldy #>sr2:jsr facmem
  81. 2028 lda #<si:ldy #>si:jsr memfac:lda #<si:ldy #>si:jsr memmult
  82. 2030 lda #<sr2:ldy #>sr2:jsr memmin:lda #<cr:ldy #>cr:jsr memplus
  83. 2032 ldx #<sr2:ldy #>sr2:jsr facmem
  84. 2034 ; si = sr*si*2 + ci
  85. 2036 lda #<sr:ldy #>sr:jsr memfac:lda #<si:ldy #>si:jsr memmult
  86. 2038 inc exp:lda #<ci:ldy #>ci:jsr memplus
  87. 2040 ldx #<si:ldy #>si:jsr facmem:ldx #4
  88. 2041 ; sr = sr2
  89. 2042 ap6 lda sr2,x:sta sr,x:dex:bpl ap6
  90. 2044 ; fac = sr*sr + si*si
  91. 2046 lda #<sr:ldy #>sr:jsr memfac:lda #<sr:ldy #>sr:jsr memmult
  92. 2048 ldx #<aw:ldy #>aw:jsr facmem
  93. 2050 lda #<si:ldy #>si:jsr memfac:lda #<si:ldy #>si:jsr memmult
  94. 2052 lda #<aw:ldy #>aw:jsr memplus
  95. 2054 ; falls fac => 8, dann divergenz
  96. 2056 lda exp:cmp #$84:bcs divergent
  97. 2060 inc i:lda i:cmp iz:bcs konvergent:jmp ap7
  98. 2070 ; bei konvergenz punkt setzen ****
  99. 2072 ; berechnung der screen-koordinaten
  100. 2074 ; y = (ci - og) * my
  101. 2076 konvergent lda #<og:ldy #>og:jsr memfac:lda #<ci:ldy #>ci:jsr memmin
  102. 2078 lda #<my:ldy #>my:jsr memmult
  103. 2080 jsr integer:tya:pha
  104. 2090 ; x = (cr - lg) * mx
  105. 2092 lda #<lg:ldy #>lg:jsr memfac:lda #<cr:ldy #>cr:jsr memmin
  106. 2094 lda #<mx:ldy #>mx:jsr memmult:jsr integer:pla:tax
  107. 2096 jsr plot
  108. 2098 ; schleifen beenden **************
  109. 2100 ; ci = ci + vy
  110. 2102 divergent lda #<ci:ldy #>ci:jsr memfac:lda #<vy:ldy #>vy:jsr memplus
  111. 2104 ldx #<ci:ldy #>ci:jsr facmem
  112. 2106 ; falls ci => ug dann fertig
  113. 2108 lda #<ci:ldy #>ci:jsr memfac:lda #<ug:ldy #>ug:jsr vergleich
  114. 2110 cmp #2:bcc ok1:jmp ap4
  115. 2112 ; cr = cr + vx
  116. 2114 ok1 lda #<cr:ldy #>cr:jsr memfac:lda #<vx:ldy #>vx:jsr memplus
  117. 2116 ldx #<cr:ldy #>cr:jsr facmem
  118. 2118 ; falls cr => rg dann fertig
  119. 2120 lda #<cr:ldy #>cr:jsr memfac:lda #<rg:ldy #>rg:jsr vergleich
  120. 2122 cmp #2:bcc ok2:jmp ap2
  121. 2124 ok2 rts
  122. 4000 ; turbo-plot-routine *************
  123. 4002 ; zeichnet einen punkt
  124. 4004 ; x-koordinate in xc
  125. 4006 ; y-koordinate im x-reg.
  126. 4010 plot txa:lsr:lsr:lsr:asl:tay:lda mult+1,y:sta av+1
  127. 4012 txa:and #7:clc:adc mult,y:sta av:lda xc:and #$f8:adc av:sta av
  128. 4014 lda av+1:adc xc+1:sta av+1:lda xc:and #7:tax:lda grbit,x
  129. 4016 ldy #0:ora (av),y:sta (av),y:rts
  130. 4020 ; zweiterpotenzen
  131. 4022 grbit .byt $80,$40,$20,$10,8,4,2,1
  132. 4024 ; multiplikationstabelle
  133. 4026 mult =*
  134. 4028 .wor $6000,$6140,$6280,$63c0
  135. 4030 .wor $6500,$6640,$6780,$68c0
  136. 4032 .wor $6a00,$6b40,$6c80,$6dc0
  137. 4034 .wor $6f00,$7040,$7180,$72c0
  138. 4036 .wor $7400,$7540,$7680,$77c0
  139. 4038 .wor $7900,$7a40,$7b80,$7cc0,$7e00
  140. 4040 ; grafik einschalten *************
  141. 4042 on ldy #0:sty av:ldx #32:lda #$60:sta av+1:tya
  142. 4044 loe sta (av),y:iny:bne loe:inc av+1:dex:bne loe
  143. 4046 ldx #4:lda #$44:sta av+1:lda #1
  144. 4048 faerb sta (av),y:iny:bne faerb:inc av+1:dex:bne faerb
  145. 4050 lda #59:sta vic+17:lda #29:sta vic+24:lda #2:sta 56576:rts
  146. 4060 ; grafik abschalten **************
  147. 4062 off lda #3:sta 56576:lda #27:sta vic+17:lda #21:sta vic+24:jmp return
  148. 5000 ; eingabe der parameter **********
  149. 5002 para lda #<text1:ldy #>text1:jsr strout
  150. 5004 jsr enter:ldx #<lg:ldy #>lg:jsr facmem
  151. 5006 lda #<text2:ldy #>text2:jsr strout
  152. 5008 jsr enter:ldx #<rg:ldy #>rg:jsr facmem
  153. 5010 lda #<text3:ldy #>text3:jsr strout
  154. 5012 jsr enter:ldx #<og:ldy #>og:jsr facmem
  155. 5014 lda #<text4:ldy #>text4:jsr strout
  156. 5016 jsr enter:ldx #<ug:ldy #>ug:jsr facmem
  157. 5017 lda #<text6:ldy #>text6:jsr strout
  158. 5018 jsr enter:jsr integer:sty iz
  159. 5019 lda #<text9:ldy #>text9:jsr strout
  160. 5020 jsr enter:ldx #<bx:ldy #>bx:jsr facmem
  161. 5021 lda #<text10:ldy #>text10:jsr strout
  162. 5022 jsr enter:ldx #<by:ldy #>by:jsr facmem
  163. 5026 lda #<text7:ldy #>text7:jsr strout
  164. 5027 jsr enter:ldx #<rx:ldy #>rx:jsr facmem
  165. 5028 lda #<text8:ldy #>text8:jsr strout
  166. 5029 jsr enter:ldx #<ry:ldy #>ry:jsr facmem
  167. 5030 ; berechnung der mult.konstanten *
  168. 5032 ; mx = bx / (rg-lg)
  169. 5034 lda #<lg:ldy #>lg:jsr memfac:lda #<rg:ldy #>rg:jsr memmin
  170. 5036 lda #<bx:ldy #>bx:jsr memdiv
  171. 5038 ldx #<mx:ldy #>mx:jsr facmem
  172. 5040 ; my = by / (ug-og)
  173. 5042 lda #<og:ldy #>og:jsr memfac:lda #<ug:ldy #>ug:jsr memmin
  174. 5044 lda #<by:ldy #>by:jsr memdiv
  175. 5046 ldx #<my:ldy #>my:jsr facmem
  176. 5048 ; berechnung der schrittweite ****
  177. 5050 ; vx = (rg-lg)/rx
  178. 5052 lda #<lg:ldy #>lg:jsr memfac:lda #<rg:ldy #>rg:jsr memmin
  179. 5054 ldx #<vx:ldy #>vx:jsr facmem
  180. 5056 lda #<rx:ldy #>rx:jsr memfac:lda #<vx:ldy #>vx:jsr memdiv
  181. 5058 ldx #<vx:ldy #>vx:jsr facmem
  182. 5060 ; vy = (ug-og)/ry
  183. 5062 lda #<og:ldy #>og:jsr memfac:lda #<ug:ldy #>ug:jsr memmin
  184. 5064 ldx #<vy:ldy #>vy:jsr facmem
  185. 5066 lda #<ry:ldy #>ry:jsr memfac:lda #<vy:ldy #>vy:jsr memdiv
  186. 5068 ldx #<vy:ldy #>vy:jmp facmem
  187. 5150 ; zahl eingeben -> fac ***********
  188. 5152 enter ldx #0
  189. 5154 input jsr bsin:cmp #13:beq drin:sta buffer,x:inx:bne input
  190. 5156 drin lda #0:sta buffer,x:lda #<buffer:ldy #>buffer
  191. 5158 sta txtptr:sty txtptr+1:jsr chr(NULL)t:jsr ascfloat:jmp round
  192. 5200 text1 .byt 13,13:.asc "apfelmaennchen-demo
  193. 5202 .byt 13,13:.[198] "(c) n. heusler 6.93
  194. 5204 .byt 13,13
  195. 5206 .asc "linker rand:          -2.1[157][157][157][157]":brk
  196. 5208 text2 .byt 13
  197. 5210 .asc "rechter rand:         0.7[157][157][157]":brk
  198. 5212 text3 .byt 13
  199. 5214 .asc "oberer rand:          -1[157][157]":brk
  200. 5216 text4 .byt 13
  201. 5218 .asc "unterer rand:         1[157]":brk
  202. 5224 text6 .byt 13
  203. 5226 .asc "iterationszahl:       240[157][157][157]":brk
  204. 5228 text7 .byt 13,13
  205. 5230 .asc "aufloesung waager.:   320[157][157][157]":brk
  206. 5232 text8 .byt 13
  207. 5234 .asc "aufloesung senkr.:    200[157][157][157]":brk
  208. 5240 text9 .byt 13,13
  209. 5242 .asc "bildgroesse waager.:  320[157][157][157]":brk
  210. 5244 text10 .byt 13
  211. 5246 .asc "bildgroesse senkr.:   200[157][157][157]":brk
  212.