home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 36.dms / 36.adf / ror.bas < prev    next >
BASIC Source File  |  1988-05-22  |  3KB  |  115 lines
  1. 1     ' ROR V1.01 (c) 1985 Kevin A. Bjorke
  2.  
  3. 2     dim oldcol%(2,31),map!(32,32),tile%(641):r!=0.:min!=0.:max!=0.:coff%=0:flag%=0:esc$=chr$(27)
  4.  
  5. 3     def fnkr!(x!,y!)=x!/y!+r!*(rnd(1)-.5):def fncolr!(p!)=int((p!-min!)/range!)
  6.  
  7. 4     screen 1,1,0:scnclr:? "ROR V 1.01":ask mouse x%,y%,b%:randomize x%*y%
  8.  
  9. 5     ?:? "One Moment.....":gosub 14:gosub 25:gosub 9:gosub 30
  10.  
  11. 6     get a$:if a$=esc$ then gosub 48:end
  12.  
  13. 7     gosub 14:gosub 25:gosub 30:goto 6
  14.  
  15. 8     end
  16.  
  17. 9     '   Store & replace original colors
  18.  
  19. 10    screen 0,5,0:for reg%=0 to 31:ask rgb reg%,x%,y%,z%
  20.  
  21. 11    oldcol%(0,reg%)=x%:oldcol%(1,reg%)=y%:oldcol%(2,reg%)=z%
  22.  
  23. 12    r%=reg%
  24.  
  25. 13    rgb reg%,r%,r%,r%:next reg%:return
  26.  
  27. 14    ' Build Topology
  28.  
  29. 15    for c%=5 to 1 step -1:st%=2^c%:bk%=st%\2:r!=8.*2.^(c%-5)
  30.  
  31. 16    if flag% then gosub 56
  32.  
  33. 17    for a%=bk% to 32 step st%:a1%=a%-bk%:a2%=a%+bk%
  34.  
  35. 18    for b%=bk% to 32 step st%:b1%=b%-bk%:b2%=b%+bk%
  36.  
  37. 19    map!(a%,b2%)=fnkr((map!(a1%,b2%)+map!(a2%,b2%)),2.)
  38.  
  39. 20    map!(a2%,b%)=fnkr((map!(a2%,b1%)+map!(a2%,b2%)),2.):if flag% then gosub 52
  40.  
  41. 21    if a%=bk% then map!(0,b%)=fnkr((map!(0,b1%)+map!(0,b2%)),2.)
  42.  
  43. 22    if b%=bk% then map!(a%,0)=fnkr((map!(a1%,0)+map!(a2%,0)),2.)
  44.  
  45. 23    map!(a%,b%)=fnkr((map!(a1%,b1%)+map!(a2%,b1%)+map!(a1%,b2%)+map!(a2%,b2%)),4.)
  46.  
  47. 24    next b%,a%,c%:return
  48.  
  49. 25    ' Calculate color set
  50.  
  51. 26    min!=0.:max!=0.:for a%=0 to 32:for b%=0 to 32:if flag% then gosub 52
  52.  
  53. 27    if map!(a%,b%)>max! then max!=map!(a%,b%) else if map!(a%,b%)<min! then min!=map!(a%,b%)
  54.  
  55. 28    next b%:if flag% then gosub 56
  56.  
  57. 29    next a%:range!=(max!-min!)/31.:return
  58.  
  59. 30    ' Draw map
  60.  
  61. 31    peno 31:box(127,63;193,129),0
  62.  
  63. 32    for a%=0 to 32:reg%=fncolr!(map!(a%,a%)):gosub 46
  64.  
  65. 33    x%=a%+128:xx%=192-a%:y%=a%+64:yy%=128-a%:box (x%,y%;xx%,yy%),0
  66.  
  67. 34    if a%=32 then 40
  68.  
  69. 35    for b%=a%+1 to 32
  70.  
  71. 36    reg%=fncolr!(map!(a%,b%)):gosub 46:box (x%,b%+64;xx%,128-b%),0
  72.  
  73. 37    reg%=fncolr!(map!(b%,a%)):gosub 46:box (b%+128,y%;192-b%,yy%),0
  74.  
  75. 38    if flag% then gosub 52
  76.  
  77. 39    next b%
  78.  
  79. 40    next a%:sshape(128,64;192,128),tile%:if not flag% then gosub 43
  80.  
  81. 41    return
  82.  
  83. 42    '
  84.  
  85. 43    for a%=0 to 256 step 64:for b%=0 to 128 step 64
  86.  
  87. 44    gshape (a%,b%),tile%():next b%,a%:flag%=-1:return
  88.  
  89. 45    '
  90.  
  91. 46    if reg%>31 then reg%=31
  92.  
  93. 47    peno reg%:return
  94.  
  95. 48    ' Put old colors back
  96.  
  97. 49    screen 1,1,0:for reg%=0 to 31
  98.  
  99. 50    rgb reg%,oldcol%(0,reg%),oldcol%(1,reg%),oldcol%(2,reg%)
  100.  
  101. 51    next reg%:return
  102.  
  103. 52    ' Cycle colors
  104.  
  105. 53    coff%=coff%+1:if coff%>31 then coff%=0
  106.  
  107. 54    for reg%=0 to 31:r%=(reg%+coff%) and 31
  108.  
  109. 55    rgb reg%,r%,r%,r%:next reg%:return
  110.  
  111. 56    ' copy ROR blocks
  112.  
  113. 57    gshape(int(rnd(1)*9)*32,int(rnd(1)*5)*32),tile%:return
  114.  
  115.