1. Akita's plasma

Hi, Guys,

I just played with Mark K. Akita's plasma program. - Fascinating, I
could not resist temptation to tinker with it. The inner loop of the
modified version below is 7 to 10 times faster, which makes it a bit
more enjoyable, especially on slower machines. I do not have Mark's
private address, so I hope it's ok by him... jiri


--  Mathpic
--  Mark K. Akita
--  5/18/00
--  modified by jiri babor, 00-05-22

without type_check
include image.e

use_vesa(1) -- if you have ATI card

constant esc = 27
integer i1,c,n1,ox1,oy1,n2,ox2,oy2,n3,ox3,oy3
integer xmax,ymax,key

sequence p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,pal
sequence p,s,si


--  Modified extract from ports.e by Jacques Deschenes, Output only:
sequence OutputCode
OutputCode = {  #50,        -- PUSH EAX
                #52,        -- PUSH EDX
                #BA,0,0,0,0,-- MOV EDX, PORT (port, to be poked in)
(3)
                #B0,#00,    -- MOV AL, byte  (byte, to be poked in)
(8)
                #EE,        -- OUT DX, AL
                #5A,        -- POP EDX
                #58,        -- POP EAX
                #C3         -- RET
             }
atom OutputAsm, OutputPort, OutputByte

procedure InitPorts()
    OutputAsm = allocate(length(OutputCode))
    if not OutputAsm then
        puts(1,"Error: memory allocation failed in InitPorts()\n")
        abort(1)
    end if
    poke(OutputAsm,OutputCode)
    OutputPort = OutputAsm + 3
    OutputByte = OutputAsm + 8
end procedure -- InitPorts()

procedure Output(integer b, integer port)
    poke4(OutputPort,port)
    poke(OutputByte,b)
    call(OutputAsm)
end procedure -- Output()

InitPorts()

global procedure set_colors(integer c, sequence s)
    -- set contiguous range of colors
    -- c is starting color index
    -- s is sequence of {r,g,b} palette entries
    -- rgb values range 0..63
    Output(c,#3C8)
    for i=1 to length(s) do
        Output(s[i][1],#3C9)
        Output(s[i][2],#3C9)
        Output(s[i][3],#3C9)
    end for
end procedure

function mp(integer x, integer y, integer ox, integer oy, integer n)

    atom a,xx,yy

    if n=1 then return and_bits(x,255)
    elsif n=2 then return and_bits(y,255)
    elsif n=3 then return floor(sin((x+ox)*PI/128)*127+128)
    elsif n=4 then return floor(sin((y+oy)*PI/128)*127+128)
    elsif n=5 then return and_bits(x+ox-y+oy+256,255)
    elsif n=6 then return floor(sin((x+ox-y+oy)*PI/128)*127+128)
    elsif n=7 then return and_bits(x+ox+y+oy,255)
    elsif n=8 then return floor(sin((x+ox+y+oy)*PI/128)*127+128)
    elsif n=9 then return
    elsif n=10 then return
    elsif n=11 then
     xx = x - ox
     yy = y - oy
     if yy != 0 then a = arctan(xx / yy) + PI / 2
     else a = 0
     end if
     return floor(cos(a * 2) * 127 + 128)
    end if
end function

procedure set_mode()
    -- set the graphics mode to highest possible resolution 256 color
mode
    if graphics_mode(261) then
        if graphics_mode(259) then
            if graphics_mode(257) then
                if graphics_mode(256) then
                    if graphics_mode(19) then
                 end if
             end if
         end if
     end if
    end if
    s=video_config()
    xmax=s[VC_XPIXELS]
    ymax=s[VC_YPIXELS]
end procedure -- set_mode

p1 = repeat({},64)
p2 = p1
p3 = p1
p4 = p1
p5 = p1
p6 = p1
p7 = p1
p8 = repeat({},256)

for x=1 to 64 do
    p1[x] = {x-1,0,0}
    p2[x] = {x-1,x-1,0}
    p3[x] = {0,x-1,0}
    p4[x] = {0,x-1,x-1}
    p5[x] = {0,0,x-1}
    p6[x] = {x-1,0,x-1}
    p7[x] = {x-1,x-1,x-1}
end for

for x=0 to 41 do
    p8[x+1] = {63,x+22,20}
end for
for x=0 to 42 do
    p8[x+43] = {63-x,63,20}
end for
for x=0 to 41 do
    p8[x+86] = {20,63,x+22}
end for

for x=0 to 42 do
 p8[x+128] = {20,63-x,63}
 p8[x+171] = {x+21,20,63}
 p8[x+214] = {x+21,20,63}
end for

p9 = p1 & p2 & p3 & p2
p10 = p3 & p4 & p5 & p4
p11 = p5 & p6 & p1 & p6
p1 = p1 & p1 & p1 & p1
p2 = p2 & p2 & p2 & p2
p3 = p3 & p3 & p3 & p3
p4 = p4 & p4 & p4 & p4
p5 = p5 & p5 & p5 & p5
p6 = p6 & p6 & p6 & p6
p7 = p7 & p7 & p7 & p7

p={p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11}

procedure new_random_pattern()
    clear_screen()
    position(2,3)
    text_color(15)
    puts(1,"Welcome to Mathpic\n")
    position(4,3)
    puts(1, "Please wait while I generate a pattern")
    position(6,3)
    puts(1, "Press Esc to exit, any other key for a new pattern...")
    position(8,3)
    ox1=rand(xmax)-1
    oy1=rand(ymax)-1
    n1=rand(3)+8
    ox2=rand(xmax)-1
    oy2=rand(ymax)-1
    n2=rand(7)+4
    ox3=rand(xmax)-1
    oy3=rand(ymax)-1
    n3=rand(10)
    for y=0 to ymax-1 do
     for x=0 to xmax-1 do
      c=mp(x,y,ox1,oy1,n1)
      c=c+mp(x,y,ox2,oy2,n2)
      c=c+mp(x,y,ox3,oy3,n3)
      si[x+1] = and_bits(c,255)
     end for
     s[y+1]=si
        if not and_bits(y,15) then
         puts(1,1)
        end if
    end for
    pal = p[rand(11)]
    set_colors(0, pal)
    clear_screen()
    display_image({0,0},s)
end procedure -- new_random_pattern

-- main --------------------------------------------------------------
set_mode()
s = repeat({}, ymax)
si = repeat(0, xmax)
new_random_pattern()
while 1 do
    pal = append(pal[2..256], pal[1])
    set_colors(0,pal)
    key = get_key()
    if key = esc then
        exit
    elsif key != -1 then
        new_random_pattern()
    end if
end while
i1=graphics_mode(-1)

new topic     » topic index » view message » categorize

Search



Quick Links

User menu

Not signed in.

Misc Menu