home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1987 May / 64er_Magazin_87-05_1987_Markt__Technik_de.d64 / bas-zellularauto (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  2KB  |  109 lines
  1. 1 rem **** zellularautomat ****
  2. 2 rem *  von ruediger lorenz  *
  3. 3 rem *      muffeter weg 41  *
  4. 4 rem ****   5100 aachen   ****
  5. 6 tb=50292
  6. 7 poke 53280,0:poke 53281,0:poke 646,1
  7. 8 dim pk(40):dimw(15,10)
  8. 10 print"[147]"
  9. 15 input"farben 0,1,2 und 3";fa(0),fa(1),fa(2),fa(3)
  10. 20 input"zuordnung (neu/alt/rnd)";a$
  11. 30 if a$="n" then goto 100
  12. 40 if a$="a" then goto 300
  13. 50 if a$="r" then goto 500
  14. 60 goto 20
  15. 99 rem ***********
  16. 100 print"summe => farbe "
  17. 105 for s=0 to 9
  18. 110 print"  ";s" => [145]"  :input"";f(s)
  19. 120 if f(s)>3 then goto 110
  20. 130 poketb+s,f(s):next
  21. 150 gosub 1000 rem start
  22. 160 print"zurueck zum menue (_)"
  23. 170 inputa$
  24. 180 if a$<>"_" then goto 100
  25. 190 goto 10
  26. 299 rem ***********
  27. 300 restore
  28. 310 for zu=0 to 15:print"<";zu">",
  29. 320 for i=0 to 9
  30. 330 read w(zu,i)
  31. 340 print w(zu,i);
  32. 350 next i
  33. 355 if zu/2<>int(zu/2) then print
  34. 358 next zu
  35. 360 input"nummer";nr
  36. 365 if nr>15 then goto 360
  37. 370 for i=0 to 9:poke tb+i,w(nr,i):f(i)=w(nr,i):next
  38. 380 gosub 1000 rem start
  39. 390 print"zurueck zum menue (_)"
  40. 400 inputa$
  41. 410 if a$<>"_" then goto 300
  42. 420 goto 10
  43. 499 rem ***********
  44. 500 print"zuordnungsvorschrift wird durch rnd-fkt erzeugt"
  45. 505 for i=0 to 9:printi;:next:print
  46. 510 for i=0 to 9
  47. 520 f(i)=int(4*rnd(1))
  48. 530 poke tb+i,f(i):printf(i);
  49. 540 next:print
  50. 550 gosub 1000 rem start
  51. 560 print"zurueck zum menue (_)"
  52. 570 inputa$
  53. 580 if a$<>"_" then goto 500
  54. 590 goto 10
  55. 999 rem ***********
  56. 1000 sys 49155
  57. 1005 input"bitmuster (selbst/rnd)";bi$
  58. 1010 if bi$="s" then gosub 3000:goto 1060
  59. 1030 input"breite des ursprungsmusters";br
  60. 1040 if br>160 then goto 1030
  61. 1045 dl=(160-br)/2
  62. 1050 for i=0+dl to 160-dl:sys 49161,i,0,int(4*rnd(1)):next
  63. 1060 sys 49152:sys 49158,fa(0),fa(1),fa(2),fa(3)
  64. 1070 sys 50176:wait 198,1
  65. 1080 get a$
  66. 1082 if a$=" " and bi$="s" then sys 49173:print"[147]":goto 1010
  67. 1084 if a$=" " then sys 49155:goto 1050
  68. 1086 if a$="^" then gosub 4000:goto 1070
  69. 1090 sys 49173:print"[147]":return
  70. 2999 rem *********
  71. 3000 sys 49155
  72. 3001 print"[147] 40 punkte breite eingabezeile"
  73. 3002 print" punktraster mit funktionstasten"
  74. 3003 print" f1=0,f3=1,f5=2,f7=3"
  75. 3004 print""
  76. 3005 wait 198,1
  77. 3020 for z=0 to 39
  78. 3030 get a$
  79. 3040 if a$="[133]" then zf=0:goto 3080
  80. 3050 if a$="[134]" then zf=1:goto 3080
  81. 3060 if a$="[135]" then zf=2:goto 3080
  82. 3070 if a$="[136]" then zf=3:goto 3080
  83. 3075 goto 3030
  84. 3080 poke 1184+z,102:poke 55456+z,fa(zf)
  85. 3090 sys 49161,60+z,0,zf:printz;:next
  86. 3100 return
  87. 3999 rem ********
  88. 4000 for w=0 to 39
  89. 4010 pk(w)=peek(w*8+15879):next
  90. 4020 sys 49155
  91. 4030 for w=0 to 39
  92. 4040 pokew*8+8192,pk(w):next:return
  93. 10000 data 3,3,0,0,2,2,1,1,0,0
  94. 10001 data 0,2,3,0,0,1,1,1,3,3
  95. 10002 data 0,1,0,2,0,3,0,1,0,0
  96. 10003 data 0,1,0,2,0,3,0,1,3,3
  97. 10004 data 3,3,1,1,2,1,3,0,2,0
  98. 10005 data 0,0,1,1,2,2,3,0,1,0
  99. 10006 data 3,0,3,1,0,1,2,0,2,0
  100. 10007 data 1,2,0,0,3,2,1,2,0,1
  101. 10008 data 0,3,3,0,3,0,2,2,1,0
  102. 10009 data 0,0,0,0,0,0,0,0,0,0
  103. 10010 data 0,0,0,0,0,0,0,0,0,0
  104. 10011 data 0,0,0,0,0,0,0,0,0,0
  105. 10012 data 0,0,0,0,0,0,0,0,0,0
  106. 10013 data 0,0,0,0,0,0,0,0,0,0
  107. 10014 data 0,0,0,0,0,0,0,0,0,0
  108. 10015 data 0,0,0,0,0,0,0,0,0,0
  109.