1     ' ROR V1.01 (c) 1985 Kevin A. Bjorke

2     dim oldcol%(2,31),map!(32,32),tile%(641):r!=0.:min!=0.:max!=0.:coff%=0:flag%=0:esc$=chr$(27)

3     def fnkr!(x!,y!)=x!/y!+r!*(rnd(1)-.5):def fncolr!(p!)=int((p!-min!)/range!)

4     screen 1,1,0:scnclr:? "ROR V 1.01":ask mouse x%,y%,b%:randomize x%*y%

5     ?:? "One Moment.....":gosub 14:gosub 25:gosub 9:gosub 30

6     get a$:if a$=esc$ then gosub 48:end

7     gosub 14:gosub 25:gosub 30:goto 6

8     end

9     '   Store & replace original colors

10    screen 0,5,0:for reg%=0 to 31:ask rgb reg%,x%,y%,z%

11    oldcol%(0,reg%)=x%:oldcol%(1,reg%)=y%:oldcol%(2,reg%)=z%

12    r%=reg%

13    rgb reg%,r%,r%,r%:next reg%:return

14    ' Build Topology

15    for c%=5 to 1 step -1:st%=2^c%:bk%=st%\2:r!=8.*2.^(c%-5)

16    if flag% then gosub 56

17    for a%=bk% to 32 step st%:a1%=a%-bk%:a2%=a%+bk%

18    for b%=bk% to 32 step st%:b1%=b%-bk%:b2%=b%+bk%

19    map!(a%,b2%)=fnkr((map!(a1%,b2%)+map!(a2%,b2%)),2.)

20    map!(a2%,b%)=fnkr((map!(a2%,b1%)+map!(a2%,b2%)),2.):if flag% then gosub 52

21    if a%=bk% then map!(0,b%)=fnkr((map!(0,b1%)+map!(0,b2%)),2.)

22    if b%=bk% then map!(a%,0)=fnkr((map!(a1%,0)+map!(a2%,0)),2.)

23    map!(a%,b%)=fnkr((map!(a1%,b1%)+map!(a2%,b1%)+map!(a1%,b2%)+map!(a2%,b2%)),4.)

24    next b%,a%,c%:return

25    ' Calculate color set

26    min!=0.:max!=0.:for a%=0 to 32:for b%=0 to 32:if flag% then gosub 52

27    if map!(a%,b%)>max! then max!=map!(a%,b%) else if map!(a%,b%)<min! then min!=map!(a%,b%)

28    next b%:if flag% then gosub 56

29    next a%:range!=(max!-min!)/31.:return

30    ' Draw map

31    peno 31:box(127,63;193,129),0

32    for a%=0 to 32:reg%=fncolr!(map!(a%,a%)):gosub 46

33    x%=a%+128:xx%=192-a%:y%=a%+64:yy%=128-a%:box (x%,y%;xx%,yy%),0

34    if a%=32 then 40

35    for b%=a%+1 to 32

36    reg%=fncolr!(map!(a%,b%)):gosub 46:box (x%,b%+64;xx%,128-b%),0

37    reg%=fncolr!(map!(b%,a%)):gosub 46:box (b%+128,y%;192-b%,yy%),0

38    if flag% then gosub 52

39    next b%

40    next a%:sshape(128,64;192,128),tile%:if not flag% then gosub 43

41    return

42    '

43    for a%=0 to 256 step 64:for b%=0 to 128 step 64

44    gshape (a%,b%),tile%():next b%,a%:flag%=-1:return

45    '

46    if reg%>31 then reg%=31

47    peno reg%:return

48    ' Put old colors back

49    screen 1,1,0:for reg%=0 to 31

50    rgb reg%,oldcol%(0,reg%),oldcol%(1,reg%),oldcol%(2,reg%)

51    next reg%:return

52    ' Cycle colors

53    coff%=coff%+1:if coff%>31 then coff%=0

54    for reg%=0 to 31:r%=(reg%+coff%) and 31

55    rgb reg%,r%,r%,r%:next reg%:return

56    ' copy ROR blocks

57    gshape(int(rnd(1)*9)*32,int(rnd(1)*5)*32),tile%:return