rem Potential ........ Rev 3.3
      rem Assembly enhanced version
      rem A J Tooth // 26th December 2005
      on error if (err=17) then quit
      
      himem=lomem + 30000000
      rem general setup
      proc_setup
      
      repeat
        rem Charges setup
        proc_setcharge
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &100
        
        rem Calculate the potential
        call pott%
        
        rem Display BMP
        command$="MDISPLAY "+str$~pic%
        oscli command$
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        
        *REFRESH
        
        a$=inkey$(300)
      until a$<>""
      
      *REFRESH ON
      quit
      end
      rem End of Program ===================================================
      rem ==================================================================
      
      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 General setup
      def proc_setup
      
      *FLOAT 64
      rem Goto fullscreen
      proc_fullscreen(xscreen%,yscreen%)
      
      *FONT Verdana,16,B
      colour 3 : print tab(5,5);"Once picture appears, Press any key to EXIT."
      a$=inkey$(100)
      
      Xlim%=xscreen% : Ylim%=yscreen% : BWid%=3*Xlim%
      
      Clim%=335540 : K=6000.0
      
      Nn%=20 : D=0.0 : P=0.0
      dim V%(Nn%),R%(Nn%,1)
      dim re% 0, gr% 0, bl% 0
      
      dim lgth% 3
      !lgth%=3*Xlim%*Ylim% + 54
      
      dim pic% !lgth%, calc% 1000, pott% 1000, c% 3, itmp% 3
      
      Sg%=0 : Val%=0
      
      rem Bitmap standard header
      proc_bmpheader
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_calc(pass&)
        proc_pott(pass&)
      next pass&
      
      *REFRESH OFF
      endproc
      rem ==================================================================
      
      rem Charges setup
      def proc_setcharge
      local a%
      
      for a%=1 to Nn%
        R%(a%,0)=rnd(Xlim%)
        R%(a%,1)=rnd(Ylim%)
        V%(a%)=rnd(Nn%)-10
      next a%
      Sg%=0 : Val%=0
      endproc
      rem ==================================================================
      
      rem Standard Header setup
      def proc_bmpheader
      
      P% = pic%
      [OPT 0
      DB "BM"          ; Signature
      DD !lgth%        ; Total file bytes
      DD 0             ; Set t0 zero
      DD 54            ; Header bytes
      DD 40            ; Offset t0 Data
      DD Xlim%         ; Image Width
      DD Ylim%         ; Image Height
      DW 1             ; Bit planes
      DW 24            ; Colour depth in bits
      DD 0             ; Compression type=0=none
      DD !lgth%-54     ; Image size net 0f header
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      ]
      endproc
      rem =======================================================================
      
      rem Assembly Language Routine
      def proc_calc(opt&)
      P%=calc%
      [opt opt&
      
      mov edx,[^Val%]
      cmp edx,255
      jg nxt1
      mov [re%],dl
      mov cl,0
      mov [gr%],cl
      mov [bl%],cl
      jmp cont
      
      .nxt1
      cmp edx,1310
      jge nxt2
      mov cl,255
      mov [re%],cl
      mov cl,0
      mov [bl%],cl
      mov eax,edx
      imul eax,50
      shr eax,8
      mov [gr%],al
      jmp cont
      
      .nxt2
      cmp edx,[^Clim%]
      jge nxt3
      mov cl,255
      mov [re%],cl
      mov [gr%],cl
      mov eax,edx
      imul eax,50
      shr eax,16
      mov [bl%],al
      jmp cont
      
      .nxt3
      mov cl,0
      mov [re%],cl
      mov [gr%],cl
      mov [bl%],cl
      
      .cont
      mov edx,[^Sg%]
      cmp edx,0
      jg ntneg
      mov bl,[re%]
      mov cl,[gr%]
      mov dl,[bl%]
      mov [gr%],bl
      mov [bl%],cl
      mov [re%],dl
      
      .ntneg
      mov eax,[^y%]
      imul eax,[^BWid%]
      add eax,[^x%]
      add eax,[^x%]
      add eax,[^x%]
      add eax,54
      
      mov cl,[bl%]
      mov pic%[eax],cl
      mov cl,[gr%]
      mov pic%[eax+1],cl
      mov cl,[re%]
      mov pic%[eax+2],cl
      
      ret
      ]
      endproc
      rem =======================================================================
      
      rem Never executed - reference only
      def proc_dump
      
      if Sg%>0 then
        proc_cols(?re%,?gr%,?bl%)
      else
        proc_cols(?gr%,?bl%,?re%)
      endif
      
      if Val%<=255 then r%=Val% : g%=0 : b%=0
      if Val%>255 and Val%<1310 then r%=255 : g%=(50*Val%)>>>8 : b%=0
      if Val%>1310 and Val%<Clim% then r%=255 : g%=255 : b%=(50*Val%)>>>16
      if Val%>Clim% then r%=0 : g%=0 : b%=0
      
      ref%=8*a%
      q%=!(^R%(0,0) + ref%)
      if D>0.0 then P+=K*V%(!c%)/D
      endproc
      rem ==================================================================
      
      rem Assembly Language Routine
      def proc_pott(opt&)
      P%=pott%
      [opt opt&
      
      mov edx,0
      mov [^x%],edx
      
      .loopx
      mov edx,0
      mov [^y%],edx
      
      .loopy
      finit
      fldz
      fstp qword [^P]
      
      mov edx,1
      mov [c%],edx
      
      .cloop
      mov eax,[c%]
      shl eax,3
      mov esi,^R%(0,0)
      add esi,eax
      fild dword [esi]
      fild dword [^x%]
      fsubp st1,st0
      fmul st0,st0
      
      fild dword [esi+4]
      fild dword [^y%]
      fsubp st1,st0
      fmul st0,st0
      
      faddp st1,st0
      fsqrt
      ftst
      fstsw ax
      sahf
      setne cl              ;Check whether D>0.0
      cmp cl,0
      je over               ;D lft 0n stack
      
      mov esi,^V%(0)
      mov eax,[c%]
      shl eax,2
      add esi,eax
      fild dword [esi]      ;Load V%(!c%)
      fld qword [^K]        ;Load K
      fmulp st1,st0
      fdivrp st1,st0        ;Divide bi D
      fld qword [^P]
      faddp st1,st0
      fstp qword [^P]
      jmp miss
      
      .over
      fstp qword [^D]       ;Dump D When D=0.0
      .miss
      
      inc dword [c%]
      mov edx,[c%]
      cmp edx,[^Nn%]
      jle near cloop
      
      fld qword [^P]
      fist dword [itmp%]
      mov edx,[itmp%]
      cmp edx,0
      jl pstv
      mov ecx,-1
      jmp psst
      .pstv
      mov ecx,1
      .psst
      mov [^Sg%],ecx
      
      fabs
      fistp dword [^Val%]
      
      call calc%             ;Plotting routine
      
      inc dword [^y%]
      mov edx,[^y%]
      cmp edx,[^Ylim%]
      jb near loopy
      
      inc dword [^x%]
      mov edx,[^x%]
      cmp edx,[^Xlim%]
      jb near loopx
      
      ret
      ]
      endproc
      rem ==================================================================