rem PrimMove ...... Rev 2.1
      rem A J Tooth // 31st December 2005
      
      rem ==================================================================
      rem Demonstrates the PRIM Algorithm to find
      rem the minimum Spanning Tree for a Network.
      rem That is, the minimum distance needed to connect to every vertex
      rem in a network without creating loops.
      rem ==================================================================
      on error if (err=17) then quit
      
      himem=lomem + 10000000
      *FLOAT 64
      
      rem Setup
      proc_setup
      
      *REFRESH OFF
      rem Initial Net View
      proc_netview
      
      ch%=0
      a$=""
      repeat
        cls
        rem PRIM Algorithm
        proc_PRIM
        rem Display the updated network
        proc_netview
        
        proc_AJTicon(20,7*ylim%/8)
        
        *REFRESH
        rem Move the vertices
        proc_move
        
        a$=inkey$(1)
      until a$<>""
      
      quit
      end
      rem End of Program ===================================================
      
      rem Setup fullscreen
      def  proc_fullscreen(return xscreen%, return yscreen%)
      
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      off : mouse off
      endproc
      rem ==================================================================
      
      rem Setup
      def proc_setup
      local a%,b%
      
      rem Go to fullscreen
      proc_fullscreen(xlim%,ylim%)
      
      proc_AJTicon(20,7*ylim%/8)
      
      input tab(5,5)"How many vertices? (50) ",num%
      if num%=0 then num%=50
      cls
      
      dim ver%(num%,2), edg(num%,num%), edgchk%(num%,num%), verseq%(num%)
      dim drw% 1000
      
      rem Random Vertices
      for a%=1 to num%
        ver%(a%,1)=rnd(xlim%)
        ver%(a%,2)=rnd(ylim%)
      next a%
      
      rem Edge distances matrix
      proc_Edge
      
      verseq%(0)=1 : rem Initial vertex is always No. 1
      
      rem Dual-pass Assembly
      for pass&=0 to 2 step 2
        proc_drw(pass&)
      next pass&
      @vdu%!248=5
      endproc
      rem ==================================================================
      
      rem Initial Net View
      def proc_netview
      local a%
      
      rem Draw the vertices themselves
      colour 10,100,255,255 : gcol 10
      for a%=1 to num%
        circle fill 2*ver%(a%,1),2*ver%(a%,2),20
      next a%
      
      endproc
      rem ==================================================================
      
      rem PRIM Algorithm
      def proc_PRIM
      local a%,b%,v%,mdis
      
      gcol 3
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      repeat
        ma%=0 : mb%=0 : mdis=100000000.0
        for v%=0 to edgcnt%
          a%=verseq%(v%) : b%=a%+1 : if b%>num% then b%=1
          
          repeat
            if ((edg(a%,b%)<mdis and edgchk%(a%,b%)<1)) then
              if ver%(b%,0)=0 then
                mdis=edg(a%,b%)
                ma%=a% : mb%=b%
              endif
            endif
            b%+=1 : if b%>num% then b%=1
          until b%=a%
        next v%
        
        rem Set the next edge, and draw it
        edgchk%(ma%,mb%)=1 : edgchk%(mb%,ma%)=1
        ver%(ma%,0)+=1 : ver%(mb%,0)+=1 : edgcnt%+=1
        verseq%(edgcnt%)=mb%
        
        call drw% : rem Draw the next connection
        
      until (edgcnt%=num%-1)
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      endproc
      rem ==================================================================
      
      rem Assembly Language Routine for Drawing
      def proc_drw(opt&)
      P%=drw%
      
      [opt opt&
      
      mov edx,[^ma%]
      shl edx,2
      mov eax,edx
      shl edx,1
      add eax,edx
      mov ebx,[eax + ^ver%(0,1)]
      shl ebx,1
      mov [^x1%],ebx
      mov ebx,[eax + ^ver%(0,2)]
      shl ebx,1
      mov [^y1%],ebx
      
      mov edx,[^mb%]
      shl edx,2
      mov eax,edx
      shl edx,1
      add eax,edx
      mov ebx,[eax + ^ver%(0,1)]
      shl ebx,1
      mov [^x2%],ebx
      mov ebx,[eax + ^ver%(0,2)]
      shl ebx,1
      mov [^y2%],ebx
      
      mov al,25                    ;Calls pl0t routine
      call "oswrch"
      mov al,4
      call "oswrch"
      mov bx,[^x1%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[^y1%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      mov al,25                    ;Calls pl0t routine
      call "oswrch"
      mov al,5
      call "oswrch"
      mov bx,[^x2%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[^y2%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      ret
      ]
      endproc
      rem ==================================================================
      
      rem Move the points
      def proc_move
      local a%
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      rem Move Vertices
      for a%=1 to num%
        ver%(a%,1)+=rnd(21)-11
        if ver%(a%,1)<0 then ver%(a%,1)=0
        if ver%(a%,1)>=xlim% then ver%(a%,1)=xlim%-1
        ver%(a%,2)+=rnd(21)-11
        if ver%(a%,2)<0 then ver%(a%,2)=0
        if ver%(a%,2)>=ylim% then ver%(a%,2)=ylim%-1
        rem Reset connection count
        ver%(a%,0)=0
      next a%
      
      rem Edge distances matrix
      proc_Edge
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      
      endproc
      rem ==================================================================
      
      rem Edge distances matrix
      def proc_Edge
      local a%,b%
      
      for a%=1 to (num%-1)
        for b%=(a%+1) to num%
          edg(a%,b%)=sqr((ver%(a%,1)-ver%(b%,1))^2 + (ver%(a%,2)-ver%(b%,2))^2)
          edg(b%,a%)=edg(a%,b%)
        next b%
      next a%
      
      rem Reset edge-count
      edgcnt%=0
      
      rem Reset edge-check matrix
      edgchk%()=0
      endproc
      rem ==================================================================
      
      rem Displays my Icon in .exe version
      def proc_AJTicon(i%,j%)
      
      sys "GetModuleHandle", 0 to hm%
      sys "LoadImage", hm%, "BBCWin", 1, 32, 32, 0 to hicon%
      w% = 32
      h% = 32
      sys "DrawIconEx", @memhdc%, i%, j%, hicon%, w%, h%, 0, 0, 3
      sys "InvalidateRect", @hwnd%, 0, 0
      endproc
      rem =====================================================================