rrutherford

NextMatrix 1.01

May 12th, 2020
541
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.   10 ; NextMatrix 1.01 © 2020 Rick Rutherford
  2.   20 RUN AT 3: CLEAR 49151
  3.   30 ON ERROR PROC EXIT()
  4.   40:
  5.   50 PROC init(): LET o=1
  6.   60 REPEAT
  7.   70    LET %c=a(o): LET c=%c: LET %n=p(c)
  8.   80    IF % SGN {n}>0 THEN PROC dispcol()
  9.   90    LET p(c)=p(c)+1: IF p(c)>r THEN LET p(c)=-7
  10.  100    IF % SGN {n}<0 THEN PROC fadecol()
  11.  110    IF %n=0 THEN PROC resetcol()
  12.  120    LET k$= INKEY$ : IF k$<>"" THEN PROC processkey(k$)
  13.  130    LET o=o+1: IF o>ac THEN LET o=1
  14.  140    IF %z=20 THEN IF bg THEN PROC glitch(1)
  15.  150    IF bg THEN LET %z=%z+1
  16.  160 REPEAT UNTIL 0
  17.  170:
  18.  180 DEFPROC processkey(k$)
  19.  190    LOCAL k
  20.  200    IF k$>="3" AND k$<="8" THEN PROC columns( VAL k$)
  21.  210    IF k$="h" THEN LET %t=% NOT t: PROC columns(ac)
  22.  220    IF k$="0" OR k$="g" OR k$="k" OR k$="m" OR k$="n" OR k$="z" THEN PROC mode(k$) TO m$
  23.  230    IF k$="b" THEN LET bg= NOT bg: PROC togglebg()
  24.  240    IF k$="q" THEN PROC EXIT()
  25.  250    LET k= CODE k$: IF (k=7 OR k=12 OR k=13 OR k=32) AND hv=0 THEN PROC help(): ELSE LET hv=0
  26.  260 ENDPROC
  27.  270:
  28.  280 DEFPROC dispcol()
  29.  290    LOCAL %l,%p
  30.  300    LET cc=% RND f+q
  31.  310    PRINT INK %c-1*7+(n-1/4)+2; AT %n-1,%c+2; CHR$ e(o)
  32.  320    IF %n<r THEN PRINT INK %254; AT %n,%c+2; CHR$ cc
  33.  330    LET e(o)=cc
  34.  340 ENDPROC
  35.  350:
  36.  360 DEFPROC fadecol()
  37.  370    BANK %b COPY %( SGN {n}+7)*7+512,%7 TO %b,%c-1*7+257
  38.  380    LAYER PALETTE %0 BANK %b,%256
  39.  390 ENDPROC
  40.  400:
  41.  410 DEFPROC resetcol()
  42.  420    LAYER ERASE %(c+2)*8,0,8,%r*8
  43.  430    BANK %b COPY %c-1*7+1,%7 TO %b,%c-1*7+257
  44.  440    LAYER PALETTE %0 BANK %b,%256
  45.  450    LET a(o)=% RND m+1
  46.  460    IF % NOT t THEN PROC initp(c)
  47.  470 ENDPROC
  48.  480:
  49.  490 DEFPROC initp(g)
  50.  500    IF g=0 THEN FOR n=1 TO m: ELSE LET n=g
  51.  510      IF %t THEN LET p(n)=0: ELSE LET p(n)=% RND 14+1
  52.  520    IF g=0 THEN NEXT n
  53.  530 ENDPROC
  54.  540:
  55.  550 DEFPROC mode(m$)
  56.  560    LET cs=1: IF m$="z" OR m$="g" OR m$="0" THEN LET cs=0
  57.  570    IF m$="0" THEN LET %f=2: LET %q=48
  58.  580    IF m$="g" THEN LET %f=110: LET %q=33
  59.  590    IF m$="k" THEN LET %f=20: LET %q=68
  60.  600    IF m$="m" THEN LET %f=56: LET %q=32
  61.  610    IF m$="n" THEN LET %f=10: LET %q=88
  62.  620    IF m$="z" THEN LET %f=94: LET %q=33
  63.  630    PROC charset(cs) TO cs: IF bg THEN PROC renderbg()
  64.  640 ENDPROC =m$
  65.  650:
  66.  660 DEFPROC glitch(%n)
  67.  670    LAYER 1,3
  68.  680    PRINT INK % RND 2+1; AT %j,%k; SCREEN$ (j,k)
  69.  690    LET %z=0: LET %j=% RND 23: LET %k=% RND 31
  70.  700    LET j=%j: LET k=%k
  71.  710    IF %n THEN PRINT INK %7; AT %j,%k; SCREEN$ (j,k)
  72.  720    LAYER 2,1
  73.  730 ENDPROC
  74.  740:
  75.  750 DEFPROC defchars()
  76.  760    LOCAL %a,%o,%r: LET %r=%49408: LET %o=2609
  77.  770    FOR %a=%0 TO %528 STEP %2
  78.  780      DPOKE %r+a,% BANK b DPEEK (a+o)
  79.  790    NEXT %a
  80.  800    PROC charset(1) TO cs
  81.  810 ENDPROC
  82.  820:
  83.  830 DEFPROC charset(%n)
  84.  840    LOCAL %a: LET %a=23606
  85.  850    IF % NOT n THEN DPOKE %a,%o: ELSE DPOKE %a,%49152
  86.  860    LAYER 2: PRINT CHR$ 2
  87.  870 ENDPROC =%n
  88.  880:
  89.  890 DEFPROC togglebg()
  90.  900    IF bg THEN REG 98,128: PROC renderbg()
  91.  910    IF NOT bg THEN REG 98,0: LAYER 1,3: CLS : LAYER 2,1
  92.  920 ENDPROC
  93.  930:
  94.  940 DEFPROC renderbg()
  95.  950    CLS : PROC initp(0)
  96.  960    LAYER 1,3: CLS
  97.  970    LOCAL c,%e,%i,%j,%s,%w,cc
  98.  980    LET c=15: LET d=1: LET x=0
  99.  990    REPEAT
  100. 1000      LET x=x+1: LET c=c+(x*d): LET d=-d
  101. 1010      INK % RND 2+1
  102. 1020      LET %s=% RND 17+1: LET %e=%s+ RND 30+1
  103. 1030      FOR %j=%s TO %e
  104. 1040        LET %w=%j: IF %w>23 THEN LET %w=%j-24
  105. 1050        LET cc=% RND f+q
  106. 1060        PRINT AT %w,c; CHR$ cc
  107. 1070      NEXT %j
  108. 1080    REPEAT UNTIL c=30
  109. 1090    LAYER 2,1
  110. 1100 ENDPROC
  111. 1110:
  112. 1120 DEFPROC scroll()
  113. 1130    LOCAL %c,%p,%v
  114. 1140    PROC refreshrate() TO %h
  115. 1150    REG 98,0: REG 97,0
  116. 1160    FOR %c=%562 TO %2608
  117. 1170      LET %v=% BANK b PEEK c
  118. 1180      IF %v=54 AND (p=129) AND (h<>50) THEN LET %v=0
  119. 1190      REG 96,%v: LET %p=%v
  120. 1200    NEXT %c
  121. 1210    REG 97,0: REG 98,128
  122. 1220 ENDPROC
  123. 1230:
  124. 1240 DEFPROC refreshrate()
  125. 1250    LOCAL %h: LET %h=%( REG 5&4)*5/2+50
  126. 1260 ENDPROC =%h
  127. 1270:
  128. 1280 DEFPROC columns(%w)
  129. 1290    LET ac=%w
  130. 1300    DIM a(ac): DIM e(ac)
  131. 1310    FOR n=1 TO ac
  132. 1320      LET a(n)= % RND (m-1)+1
  133. 1330      LET e(n)=% RND f+q
  134. 1340    NEXT n
  135. 1350    PROC initp(0)
  136. 1360    LAYER 2: CLS
  137. 1370 ENDPROC
  138. 1380:
  139. 1390 DEFPROC init()
  140. 1400    LET r6=% REG 6: REG 6,% REG 6&119
  141. 1410    BANK NEW %b: BANK %b ERASE
  142. 1420    LOAD "NextMatrix.dat" BANK %b
  143. 1430    LAYER CLEAR : PALETTE CLEAR
  144. 1440    LAYER 0: BORDER 0: PAPER 0: INK 7: CLS
  145. 1450    LAYER 1,3: PALETTE DIM 8: PALETTE FORMAT 255: REG 38,4
  146. 1460    FOR %i=%0 TO %7: LAYER PALETTE %0,%i,%i*8: NEXT %i
  147. 1470    LAYER 2,0: PALETTE DIM 8: BORDER 0: PAPER 227: CLS
  148. 1480    LAYER PALETTE %0 BANK %b,%256: INK 255
  149. 1490    LET %o=% DPEEK 23606: PROC defchars(): LET m$="m"
  150. 1500    LET %m=%27: LET m=%m: LET %r=%24: LET r=%r: LET cs=1
  151. 1510    DIM p(m): LET %f=%56: LET %q=%32: LET %t=1: LET hv=0
  152. 1520    LET %j=0: LET j=0: LET %k=0: LET k=0: LET %z=0: LET bg=1
  153. 1530    PROC scroll(): PROC renderbg(): PROC columns(5)
  154. 1540 ENDPROC
  155. 1550:
  156. 1560 DEFPROC EXIT()
  157. 1570    REG 98,0: REG 38,0: REG 39,0: REG 6,r6
  158. 1580    PROC charset(0)
  159. 1590    LAYER CLEAR : PALETTE CLEAR : CLS
  160. 1600    GO TO %9999
  161. 1610 ENDPROC
  162. 1620:
  163. 1630 DEFPROC p(t$,%x,%y,%i)
  164. 1640    PRINT INK %i; AT %x,%y;t$
  165. 1650 ENDPROC
  166. 1660:
  167. 1670 DEFPROC help()
  168. 1680    PROC glitch(0): CLS : PROC charset(0)
  169. 1690    LOCAL %h,%i,k,k$: LET %h=253: LET %i=255
  170. 1700    PROC p("NextMatrix 1.01",5,9,%h)
  171. 1710    PROC p("© 2020 Rick Rutherford",6,5,%h)
  172. 1720    PROC p("3-8",8,4,%h): PROC p("Active columns",8,8,%i)
  173. 1730    PROC p("h",9,5,%h): PROC p("Full/random height",9,8,%i)
  174. 1740    PROC p("b",10,5,%h): PROC p("Toggle background",10,8,%i)
  175. 1750    PROC p("q",11,5,%h): PROC p("Quit",11,8,%i)
  176. 1760    PROC p("Modes",13,14,%h)
  177. 1770    PROC p("m",15,5,%h): PROC p("Matrix",15,8,%i): PROC p("k",15,16,%h): PROC p("Katakana",15,19,%i)
  178. 1780    PROC p("0",16,5,%h): PROC p("Binary",16,8,%i): PROC p("n",16,16,%h): PROC p("Numbers",16,19,%i)
  179. 1790    PROC p("z",17,5,%h): PROC p("ZX",17,8,%i): PROC p("g",17,16,%h): PROC p("ZX w/gfx",17,19,%i)
  180. 1800    REPEAT : LET k$= INKEY$ : REPEAT UNTIL k$<>""
  181. 1810    LET k= CODE k$: IF k=7 OR k=12 OR k=13 OR k=32 THEN LET hv=1: CLS : PROC charset(cs): ELSE CLS : PROC charset(cs): PROC processkey(k$)
  182. 1820 ENDPROC
RAW Paste Data