0hc.net Menu
Home Overview
About Menu
Impressum

Turmite

Fortran 95: ! ! program: j_ameisen ! author: Harald Wolfsgruber ! last change: 23.04.06 ! module fracta implicit none public :: cutrt contains subroutine cutrt(pos,spos,npos) integer, dimension(1:2), intent(in) :: pos, spos integer, dimension(1:2), intent(out) :: npos integer :: i npos=pos do i=1, 2, 1 if(pos(i)>spos(i))npos(i)=1 if(pos(i)<1)npos(i)=spos(i) end do end subroutine cutrt end module fracta program j_ameisen use japi use fracta implicit none integer :: i, j, jstat, io_err integer :: frame, canvas, menuebar, file, mfstart, mfstop, mfquit, obj integer, parameter :: statm=4 integer, dimension(1:statm) :: stamust=0 integer, dimension(1:2), parameter :: spos=(/500,500/) integer, dimension(1:2) :: pos=(/int(spos(1)/2),int(spos(2)/2)/), npos integer, dimension(spos(1),spos(2)) :: field=0 integer :: richtung=1 integer, dimension(1:z"ff") :: regelk integer :: zaeler=0, jzael=0 character(len=z"ff") :: regelkette write(*,*) "Loading..." if( .not. j_start()) then write(*,*) "can't connect to JAPI server" stop end if stamust=(/0,0,0,0/) do i=1, spos(1), 1 do j=1, spos(2), 1 field(i,j)=stamust(mod(i+i*j,statm)+1) end do end do write(*,*) "Regelkette:" read(*,*) regelkette jzael=len_trim(regelkette) do i=1, jzael, 1 read(regelkette(i:i),*,iostat=io_err) regelk(i) if(io_err/=0) then write(*,*) "not a valid input in", i cycle end if end do frame = j_frame("Turmiten") menuebar = j_menubar(frame) file = j_menu(menuebar,"File") mfstart = j_menuitem(file,"Start") mfstop = j_menuitem(file,"Stop") mfquit = j_menuitem(file,"Quit") canvas = j_canvas(frame,spos(1),spos(2)) call j_setpos(canvas,10,50) call j_setnamedcolorbg(canvas, 1) call j_setnamedcolor(canvas, 0) call j_show(frame) call j_pack(frame) jstat=0 do if(jstat==0) then obj=j_nextaction(); else obj=j_getaction(); end if if((obj == frame) .or. (obj == mfquit)) then call j_quit() stop else if(obj==mfstart) then; jstat=1; zaeler=0 else if(obj==mfstop) then; jstat=0 end if zaeler=zaeler+1 do i=1, jzael, 1 if(field(pos(1),pos(2))==i-1) then if(regelk(i)==0) richtung=(mod((richtung-1),4)) if(regelk(i)==1) richtung=(mod((richtung+1),4)) call j_setnamedcolor(canvas, mod(i,16)-1) call j_drawpixel(canvas,pos(1),pos(2)) j=i if(i==jzael) j=0 field(pos(1),pos(2))=j exit end if end do if(richtung==0) then; richtung=4; pos(2)=pos(2)-1 else if(richtung==1) then; pos(1)=pos(1)+1 else if(richtung==2) then; pos(2)=pos(2)+1 else if(richtung==3) then; pos(1)=pos(1)-1 end if call cutrt(pos,spos,npos) pos=npos end do end program j_ameisen
0hc.net    © 2001-2014 Harald Wolfsgruber