rule XOR

[tsh73]

(EDIT nothing new really. I found almost same code from 2013)

As simple as it gets. But...

'tsh73 Jun 2019
'Rule XOR rulez
nomainwin
WindowHeight = 850
WindowWidth = 830
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"

#gr "home"
#gr "posxy cx cy"

#gr "rule xor"

N=400
for i = 0-N to N-1
   #gr "line ";cx;" ";cy;" ";cx+N;" ";cy-i
   #gr "line ";cx;" ";cy;" ";cx-N;" ";cy+i
   #gr "line ";cx;" ";cy;" ";cx+i;" ";cy+N
   #gr "line ";cx;" ";cy;" ";cx-i;" ";cy-N
next

wait

[quit]
   close #gr
end


(I have a few ideas about it)

[code]

Nice effect, thx !

[tsh73]

OK, a few more
If we run line's outer end along circle, not a line?
'tsh73 Jun 2019
'Rule XOR rulez
nomainwin
WindowHeight = 850
WindowWidth = 830
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"

#gr "home"
#gr "posxy cx cy"

#gr "rule xor"

N=1000
pi = acs(-1)
for a = 0 to 2*pi step 1/N*4
   x=N*cos(a)
   y=N*SIN(a)
   #gr "line ";cx;" ";cy;" ";cx+x;" ";cy+y
next

wait

[quit]
   close #gr
end

( it would look nice even without XOR - not so nice though)

[tsh73]

But hey! I've seen this before! It's smoking clover
- code from 2013
'Smoking clover
'tsh73 Oct 2013
'along of http://www.catb.org/jargon/html/S/smoking-clover.html
'v.06: 1/8, draw later on
'v.07: shifting palette

nomainwin

gosub [getSlack]

global d
dim PAL$(512)    'colors as text, like "255 100 23"

global MaxX, MaxY, rough, MaxColor
global PAL2BMPstr$

d = 300
c = d/2
WindowWidth=d+slackX
WindowHeight=d+slackY
open "Smoking clover" for graphics_nsb as #gr
#gr "trapclose quit"
#gr "down"

dim colr(d,d)

r = 2000
ll = 2*acs(-1)*r
pi = acs(-1)
for a = 0-50/r to pi/4+50/r step 1/r
   scan
   x=c+r*cos(a)
   y=c+r*sin(a)
   #gr "line ";c;" ";c;" ";x;" ";y
   call aLine c, c, x ,y
   'fill array colr(,)
next

'copy filled 1/8 to other places. Apply MOD in process
   MaxColor = 32
for i = 0 to c
   for j = 0 to i
       'print i, j, colr(c+i,c+j)
       colr = colr(c+i,c+j) mod MaxColor
       colr(c+i,c+j) = colr
       colr(c+i,c-j) = colr
       colr(c-i,c+j) = colr
       colr(c-i,c-j) = colr

       colr(c+j,c+i) = colr
       colr(c+j,c-i) = colr
       colr(c-j,c+i) = colr
       colr(c-j,c-i) = colr
   next
next

call Makepalette
'for i = 0 to 512
'    print i, PAL$(i)
'next
'wait

'color stuff
goto [skipColor]
for i = 0 to d
   for j = 0 to d
       #gr "color ";PAL$(colr(i,j))
       #gr "set ";i;" ";j
   next
   #gr "discard"
next

#gr "getbmp KeepIt 0 0 ";d;" ";d
#gr "drawbmp KeepIt 0 0 ";d;" ";d
#gr "flush"

[skipColor]
'-----------------------------------------
   width = d
   height = d
   call tryToKill "just4header.bmp"
'    easiest way to get right BMP header is to actually save BMP and look header (just change BPP and some other things after)
    #gr, "getbmp drawing 0 0 ";width;" ";height
    bmpsave "drawing", "just4header.bmp"
    unloadbmp("drawing")
'    get header
   open "just4header.bmp" for binary as #1
       size = lof(#1)
       header$ = input$(#1, 53)
   close #1
'    modify header
   'numbers stored hi lo
   '2  4 fileSize                                    = imagebytes + offset
   '10 4 offset                                      1078
   '28 2 BitsPerPixel (bpp)                          8
   '30 4 CompressMethod                              0
   '34 4 imagebytes                                  width*height
   '46 4 ColorsUsed                                  256
   '50 4 ImportantColors                             256
   'all goes +1 because bytes numbered from zero by loc()
   call putNumber header$, 2+1, 4, width*height + 1078
   call putNumber header$, 10+1, 4, 1078
   call putNumber header$, 28+1, 2, 8
   call putNumber header$, 30+1, 4, 0
   call putNumber header$, 34+1, 4, width*height
   call putNumber header$, 46+1, 4, 256
   call putNumber header$, 50+1, 4, 256

'    write image data
   call tryToKill "frame.bmp"  'because JB does not overwrite if BMP is smaller.
   ', and it siglifically slows things down
   open "frame.bmp" for binary as #1
   '    write modif. header
       print  #1, header$; 'Here LBB needs (;)
   '    write palette
       print  #1, mid$(PAL2BMPstr$, 1, 256*4); 'Here LBB needs (;)
   '    write image data
       FOR y = d-1 TO 0 step -1
           aLine$ = ""
           FOR x = 0 TO d-1
                   aLine$ =  aLine$ + chr$(colr(x,y))
           next
           aLine$ = aLine$ + space$(width-len(aLine$))   'filler by x
           print #1, aLine$;   'Here LBB needs (;)
       next
       'filler by y
       FOR y = d to height
           print #1, aLine$;   'Here LBB needs (;)
       next

   close #1

'-----------------------------------------
'MAIN LOOP
   tOld = time$("seconds")
   iterOld = 0
   do while 1
       iter=iter+1
       open "frame.bmp" for binary as #1
           seek #1, 54 'palette data
           print  #1, mid$(PAL2BMPstr$, 1+k*4, 256*4);
       close #1
       loadbmp "copyimage", "frame.bmp"
       #gr, "drawbmp copyimage 0 0"
       unloadbmp("copyimage")
       #gr, "discard"
       scan
       k = (k+1) mod MaxColor             'fly to us
       'k = (k-1 + MaxColor) mod MaxColor  'fly from us

       'fps code
       goto [skipFps]
       t = time$("seconds")
       if t<>tOld then
           fps = (iter - iterOld)
           locate 1, 11 + aLine mod 10
           print n,d,"Time taken: ";tt ;" fps: "; fps
           locate 1, 11 + aLine mod 10 + 1
           print space$(80)
           aLine=aLine+1
           tOld = t
           iterOld = iter
       end if
       [skipFps]
   loop
   wait
'-----------------------------------------

wait

sub quit handle$
  timer 0
  close #handle$
  'clean-up
  call tryClose1
  call tryToKill "frame.bmp"
  call tryToKill "just4header.bmp"
  end
end sub

sub aLine x0,y0,x1,y1
   x0=int(x0):x1=int(x1)   'will hang without it.
   y0=int(y0):y1=int(y1)
   dx = abs(x1-x0)
   sx = -1: if x0<x1 then sx=1
   dy = abs(y1-y0)
   sy = -1: if y0<y1 then sy=1
   er = 0-dy: if dx>dy then er=dx
   er = int(er/2)
   while 1
       if x0>0 and x0 <d and y0>0 and y0 <d then
           colr(x0,y0) = colr(x0,y0)+1
       else
           exit sub
       end if
       if x0=x1 AND y0=y1 then exit sub
       e2 = er
       if e2 >0-dx then er = er-dy: x0 = x0+sx
       if e2 < dy then er = er+dx: y0 = y0+sy
   wend
end sub

'---------------------------------------------
' 0..1 into red-green-blue-red continuous colors
function rainbow$(x)
   hi = int((x*6) mod 6)+ 5*(x<0)  'fixed to 0..5
   f = (x*6) mod 1 + (x<0)         'frac, 0..1
   q = (1-f)
   select case hi
   case 0
       r = 1: g = f: b = 0
   case 1
       r = q: g = 1: b = 0
   case 2
       r = 0: g = 1: b = f
   case 3
       r = 0: g = q: b = 1
   case 4
       r = f: g = 0: b = 1
   case 5
       r = 1: g = 0: b = q
   end select
   R = int(r*255)
   G = int(g*255)
   B = int(b*255)
   rainbow$= R;" ";G;" ";B
end function
'------------------------------------------
sub putNumber byref aStr$, aPos, aLen, value
   tmp$=""
   for i = 1 to aLen
       'tmp$=chr$(value mod 256)+tmp$   'numbers stored hi lo
       tmp$=tmp$+chr$(value mod 256)   'numbers stored lo hi
       value = int(value/256)
   next
   aStr$ = left$(aStr$, aPos-1)+tmp$+mid$(aStr$, aPos+aLen)
end sub
'------------------------------------------

sub tryToKill bmp$
   on error goto [skip]
   kill bmp$
[skip]
end sub

sub tryClose1
   on error goto [skip]
   close #1
[skip]
end sub

'------------------------------------------------------
SUB Makepalette
   PAL2BMPstr$ = ""
   FOR c = 0 TO 512
       PAL$(c) = rainbow$(c/MaxColor)
   NEXT
   for i = 0 to 512
       PAL2BMP$ = chr$(val(word$(PAL$(i),3))) _
           + chr$(val(word$(PAL$(i),2))) _
           + chr$(val(word$(PAL$(i),1))) _
           + chr$(0)
       'print i,  PAL2BMP$(i)
       PAL2BMPstr$ = PAL2BMPstr$ + PAL2BMP$
   next
END SUB

[getSlack]
   WindowWidth=200:WindowHeight=200
   open "" for graphics_nsb as #t:#t,"home;posxy x y":close#t
   slackX=WindowWidth-2*x:slackY=WindowHeight-2*y
return



[B+]

Cool! Amazing what a little code can do!

[B+]

Try this with some plasma colorizing:

'tsh73 Jun 2019 mod colorized version B+
'Rule XOR rulez
nomainwin
global rrr, ggg, bbb, ccc
WindowHeight = 750
WindowWidth = 730
open "XOR Framed frames Colorized" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "down"

#gr "home"
#gr "posxy cx cy"
#gr "rule xor"
N = 300
while 1
   scan
   #gr "fill black; flush"
   call setRGB
   for i = 0-N to N-1
       call changeRGB
       #gr "line ";cx;" ";cy;" ";cx+N;" ";cy-i
       #gr "line ";cx;" ";cy;" ";cx-N;" ";cy+i
       #gr "line ";cx;" ";cy;" ";cx+i;" ";cy+N
       #gr "line ";cx;" ";cy;" ";cx-i;" ";cy-N
   next
   call pause 1500
wend
wait

sub quit H$
   close #H$ '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

sub setRGB
   rrr = rnd(0)^2 : ggg = rnd(0)^2 : bbb = rnd(0)^2
end sub

sub changeRGB
   ccc = ccc + .125
   c$ = 127 + 127 * sin(rrr * ccc);" ";127 + 127 * sin(ggg * ccc);" ";127 + 127 * sin(bbb * ccc)
   #gr "color ";c$
   #gr "backcolor ";c$
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub




And this:
'tsh73 Jun 2019 colorize mod b+
'Rule XOR rulez
global rrr, ggg, bbb, ccc
nomainwin
WindowHeight = 750
WindowWidth = 730
open "XOR Clover unless size > 1" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "down"
#gr "home"
#gr "posxy cx cy"
#gr "rule xor"
#gr "size 1"  '<<<<<<<<<<<<<< try size 2
pi = acs(-1)
N=1024
while 1
   scan
   call setRGB
   #gr "fill black"
   for a = 0 to 2*pi step 1/N*4
       scan
       call changeRGB
       x=N*cos(a)
       y=N*SIN(a)
       #gr "line ";cx;" ";cy;" ";cx+x;" ";cy+y
   next
   call pause 1500
wend
wait

sub quit H$
   close #H$
   end
end sub

sub setRGB
   rrr = rnd(0)^2 : ggg = rnd(0)^2 : bbb = rnd(0)^2
end sub

sub changeRGB
   ccc = ccc + 2
   c$ = 127 + 127 * sin(rrr * ccc);" ";127 + 127 * sin(ggg * ccc);" ";127 + 127 * sin(bbb * ccc)
   #gr "color ";c$
   #gr "backcolor ";c$
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub


[tsh73]

Somehow my yesterday night post did not registered.

Colors are stunning;
turning XOR off gives some nice clean color shifts in program 1 and some subtle patterns in program 2.

[B+]

Hi tsh73,

Did you try a different size in #2? No longer a 4 leaf clover... which kind of surprised me. I was hoping to get rid of holes or interference patterns, nope, got something unexpected.

[tsh73]

Running tunnel effect
'tsh73 Jun 2019
'Rule XOR rulez
nomainwin
WindowHeight = 600'850
WindowWidth = 830
open "test" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"

#gr "home"
#gr "posxy cx cy"

#gr "rule xor"

NN=7
N=100
for k=0 to NN-1
N=k*25+100
'N=int(N*1.15)
#gr "CLS"
for i = 0-N to N-1
   #gr "line ";cx;" ";cy;" ";cx+N;" ";cy-i
   #gr "line ";cx;" ";cy;" ";cx-N;" ";cy+i
   #gr "line ";cx;" ";cy;" ";cx+i;" ";cy+N
   #gr "line ";cx;" ";cy;" ";cx-i;" ";cy-N
next
'    r = 100
'    #gr "color red"
'    #gr "place ";cx-r;" ";cy-r
'    #gr "boxfilled ";cx+r;" ";cy+r
'    #gr "color black"

#gr "getbmp frame";k;" ";cx-100;" ";cy-100;" ";200;" ";200
'timer 3000, [nxt]
'wait
[nxt]
timer 0
next

#gr "rule over"
#gr "backcolor black"
'r=10   'uncomment to make center black
'for i = 0 to NN-1'1000
for i = 0 to 1000
   #gr "CLS"
   k = i mod NN
   #gr "drawbmp  frame";k;" ";cx-100;" ";cy-100
   #gr "place ";cx-r;" ";cy-r
   #gr "boxfilled ";cx+r;" ";cy+r
   timer 60, [nxt2]
   wait
[nxt2]
timer 0
next
wait

[quit]
   close #gr
end