rem Heat ....... Rev 8.1
      rem A J Tooth // 8th August 2004
      rem Assembly Language enhanced
      on error if (err=17) then quit
      
      rem ==================================================
      rem This program calculates a very simple Finite Element
      rem solution to the Heat Equation.
      rem ==================================================
      
      *FLOAT64
      proc_fullscreen
      himem=lomem + 40000000
      
      rem Setup Procedure
      proc_setup : cls : clg
      rem Display my Icon in compiled version
      proc_AJTicon(10,10)
      
      rem Setup initial state of hot-plate
      proc_plate
      
      *REFRESH OFF
      rem Allows Revising temp. dist with the mouse
      proc_revise
      cls
      colour 2
      rem Display my Icon in compiled version
      proc_AJTicon(10,10)
      
      rem MAIN ROUTINE
      repeat
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &100
        
        rem Estimate second partial derivatives
        call pd2%
        
        rem Calculate estimate for next Heat value
        call est%
        
        rem Plot next state of the hot-plate as it cools
        call mast%
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        
        *REFRESH
        a$=inkey$(5)
      until a$<>""
      
      *REFRESH ON
      a$=get$
      quit
      end
      
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++
      
      rem Set up use of Full Screen
      def proc_fullscreen
      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
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Setup procedure
      def proc_setup
      colour 3:print tab(5,5);"Select small, medium or large grid. (s/m/l)";
      repeat
        s$=get$
      until (s$="s" or s$="m" or s$="l")
      colour1 : print tab(50,5);s$
      
      colour 3: print tab(5,7);"Cold plate or hot plate? Press -c- or -h-. "
      repeat
        ch$=get$
        if ch$<>"h" then ch$="c"
      until (ch$="h" or ch$="c")
      cls
      
      dim Mul% 0, j% 3, k% 3, u% 3, v% 3, Shl% 0, Ref% 3, Refu% 3, Refd% 3, Refdd% 3
      dim Size% 3, XtSize% 3, Ref1% 3, Xnum% 3, Ynum% 3, Fset% 3
      dim a% 3, b% 3, x% 3, y% 3, aa% 3, bb% 3
      
      case s$ of
        when "s","S" : !Xnum%=60 : !Ynum%=40   : ?Mul%=32 : ?Shl%=5
        when "m","M" : !Xnum%=240 : !Ynum%=160 : ?Mul%=8  : ?Shl%=3
        when "l","L" : !Xnum%=480 : !Ynum%=320 : ?Mul%=4  : ?Shl%=2
        otherwise
          !Xnum%=60 : !Ynum%=40
      endcase
      
      !Size%=8*!Xnum%*!Ynum%
      !XtSize%=8*(!Xnum%+2)*(!Ynum%+2)
      
      dim r% 3, g% 3 ,b% 3, U0% 7, FivHun% 3, TTFiv% 3, Dmp% 7
      dim c% 7, Dt% 7, Fac% 7
      dim Vt1% !Size%, Vt0% (3*(!XtSize%))
      
      rem Factors
      |c%=1.3 : |Dt%=.1 : |Fac%=|c%*|c%*|Dt%
      !FivHun%=500 : !TTFiv%=225
      
      rem Dual-pass assembly, in case of labels
      dim pltt% 1000, colset% 500, mast% 500, est% 500, pd2% 1000
      for pass%=0 to 2 step 2
        proc_pd2(pass%)
        proc_est(pass%)
        proc_colset(pass%)
        proc_pltt(pass%)
        proc_mast(pass%)
      next pass%
      
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Setup initial state of hot-plate
      def proc_plate
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      
      rem Initialise surrounding temperature to ZERO
      for x%=0 to (!Xnum%+1)
        !Ref%=8*x%
        |(Vt0%+!Ref%)=0.0
        !Ref%=8*((!Xnum%+2)*(!Ynum%+1) + x%)
        |(Vt0%+!Ref%)=0.0
      next x%
      for y%=0 to (!Ynum%+1)
        !Ref%=8*(y%*(!Xnum%+2))
        |(Vt0%+!Ref%)=0.0
        !Ref%=8*(y%*(!Xnum%+2) + (!Xnum%+1))
        |(Vt0%+!Ref%)=0.0
      next y%
      
      rem Initialise plate temperature to 1000
      for x%=1 to !Xnum%
        for y%=1 to !Ynum%
          !Ref%=8*(y%*(!Xnum%+2) + x%)
          if ch$="h" then
            |(Vt0%+!Ref%)=1000.0
          else
            |(Vt0%+!Ref%)=0.0
          endif
        next y%
      next x%
      
      rem Initial status
      for !j%=1 to !Xnum%
        for !k%=1 to !Ynum%
          !Ref%=8*(!k%*(!Xnum%+2) + !j%)
          if |(Vt0%+!Ref%)<0 then |(Vt0%+!Ref%)=0
          if |(Vt0%+!Ref%)>500 then
            ?r%=255:?g%=30+int(225*(|(Vt0%+!Ref%)-500)/500)
          else
            ?g%=30:?r%=30+int(225*|(Vt0%+!Ref%)/500)
          endif
          call pltt%
        next
      next
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Allows Revising temp. dist with the mouse
      def proc_revise
      mouse on
      mouse rectangle 64+?Mul%,64+?Mul%,1919,1279
      *REFRESH
      
      repeat
        mouse p%,q%,Bt%
        xx%=int((p%-64)/?Mul%)
        yy%=int((q%-64)/?Mul%)
        !Ref%=8*(yy%*(!Xnum%+2) + xx%)
        if Bt%=(4+3*(ch$="c")) then
          |(Vt0%+!Ref%)=0.0
          colour 10,30,30,30 : gcol 10
          rectangle fill 64+?Mul%*xx%,64+?Mul%*yy%,?Mul%
        endif
        if Bt%=(1-3*(ch$="c")) then
          |(Vt0%+!Ref%)=1000.0
          colour 10,255,255,30 : gcol 10
          rectangle fill 64+?Mul%*xx%,64+?Mul%*yy%,?Mul%
        endif
        *REFRESH
        a$=inkey$(1)
      until a$=" "
      mouse rectangle off
      mouse off
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Assembly Language Routine 1
      rem for PLOT Function
      def proc_pltt(opt%)
      P%=pltt%
      [opt opt%
      
      mov al,[vdsetcol%]      ;Changes the rgb vlue f0r colr 10
      call "oswrch"
      mov al,[cl%]
      call "oswrch"
      mov al,[paltyp%]
      call "oswrch"
      mov al,[r%]
      call "oswrch"
      mov al,[g%]
      call "oswrch"
      mov al,30
      call "oswrch"
      
      mov al,[vdgcol%]       ;Calls gc0l routine
      call "oswrch"
      mov al,[md%]
      call "oswrch"
      mov al,[cl%]
      call "oswrch"
      
      mov ebx,[j%]           ;Calculate u%,v%
      mov cl,[Shl%]
      shl ebx,cl
      add ebx,64
      mov [u%],ebx
      mov ebx,[k%]
      mov cl,[Shl%]
      shl ebx,cl
      add ebx,64
      mov [v%],ebx           ;Calculate u%,v%
      
      mov al,[vdcode%]       ;m0ve u%,v%
      call "oswrch"
      mov al,[vdmov%]
      call "oswrch"
      mov bx,[u%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[v%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"          ;m0ve u%,v%
      
      mov al,[vdcode%]       ;rect f1ll u%+Mul%,v%+Mul%
      call "oswrch"
      mov al,[vdrect%]
      call "oswrch"
      mov bx,[u%]
      mov cx,0
      mov cl,[Mul%]
      add bx,cx
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[v%]
      mov cx,0
      mov cl,[Mul%]
      add bx,cx
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"          ;rect f1ll u%+Mul%,v%+Mul%
      
      jmp round              ;Various constants
      .vdcode% db 25
      .vdmov% db 4
      .vdrect% db 101
      .vdsetcol% db 19
      .paltyp% db 16
      .vdgcol% db 18
      .md% db 0
      .cl% db 10
      .round ret
      ]
      endproc
      
      rem Plot sequence in Assembler
      def proc-dump
      colour 10,?r%,?g%,30 : gcol 10 : rem Done
      !u%=64+?Mul%*!j% : !v%=64+?Mul%*!k% : rem Done
      rectangle fill !u%,!v%,?Mul% : rem Done
      colour 10,?r%,?g%,30 : gcol 10
      !u%=64+?Mul%*!j% : !v%=64+?Mul%*!k%
      rectangle fill !u%,!v%,?Mul%
      
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Assembly Language Routine 2
      rem for Colour setting
      def proc_colset(opt%)
      P%=colset%
      [opt opt%
      
      finit
      mov eax,[Ref1%]
      fld qword Vt1%[eax]
      mov ebx,[Ref%]
      fst qword Vt0%[ebx]
      fldz
      fcomp st1
      fstsw ax
      sahf
      setc al
      cmp al,1
      je ntless
      fstp qword [Dmp%]
      fldz
      fst qword Vt0%[ebx]
      
      .ntless
      fild dword [FivHun%]
      fcomp st1
      fstsw ax
      sahf
      setc al
      cmp al,1
      jne low
      mov bl,255                 ;Number is HIGH
      mov [r%],bl
      fild dword [FivHun%]
      fsub st1,st0
      fdivp st1,st0
      fild dword [TTFiv%]
      fmulp st1,st0
      fistp dword [g%]
      mov bl,[g%]
      add bl,30
      mov [g%],bl
      jmp over
      
      .low                      ;Number is LOW
      mov bl,30
      mov [g%],bl
      fild dword [FivHun%]
      fdivp st1,st0
      fild dword [TTFiv%]
      fmulp st1,st0
      fistp dword [r%]
      mov bl,[r%]
      add bl,30
      mov [r%],bl
      
      .over
      ret
      ]
      endproc
      
      rem Colour decision in Assembler
      def proc_dump2
      |(Vt0%+!Ref%)=|(Vt1%+!Ref1%) : rem Done
      if |(Vt0%+!Ref%)<0.0 then |(Vt0%+!Ref%)=0.0  : rem Done
      if |U0%>500.0 then
        ?r%=255:?g%=30+int(225*(|U0%-500)/500) : rem All Done
      else
        ?g%=30:?r%=30+int(225*|U0%/500) : rem All Done
      endif
      endproc
      
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Assembly Language Routine 3
      rem Master Routine
      def proc_mast(opt%)
      P%=mast%
      [opt opt%
      
      mov eax,0                ;Initialise j-loop control
      mov [j%],eax
      .again
      inc dword [j%]
      
      mov eax,0                ;Initialise k-loop control
      mov [k%],eax
      .bgain
      inc dword [k%]
      
      mov eax,[Xnum%]      ;Ref% calculation
      add eax,2
      mov ebx,[k%]
      mul ebx
      add eax,[j%]
      shl eax,3
      mov [Ref%],eax       ;Ref% calculation
      
      mov eax,[Xnum%]      ;Ref1% calculation
      mov ebx,[k%]
      dec ebx
      mul ebx
      mov ebx,[j%]
      dec ebx
      add eax,ebx
      shl eax,3
      mov [Ref1%],eax      ;Ref1% calculation
      
      call colset%
      call pltt%
      
      mov eax,[k%]
      cmp eax,[Ynum%]
      jl near bgain
      
      mov eax,[j%]
      cmp eax,[Xnum%]
      jl near again
      
      ret
      ]
      endproc
      
      rem Integer Calculations
      def proc_dump3
      !Ref%=8*(!k%*(!Xnum%+2) + !j%) : rem Done
      !Ref1%=8*((!k%-1)*!Xnum% + (!j%-1)) : rem Done
      endproc
      
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Assembly Language Routine 4
      rem Estimation using 2nd order PD Routine
      def proc_est(opt%)
      P%=est%
      [opt opt%
      
      mov eax,0                ;Initialise a-loop control
      mov [a%],eax
      .cgain
      inc dword [a%]
      
      mov eax,0                ;Initialise b-loop control
      mov [b%],eax
      .dgain
      inc dword [b%]
      
      mov eax,[Xnum%]      ;Ref% calculation
      add eax,2
      mov ebx,[b%]
      mul ebx
      add eax,[a%]
      shl eax,3
      mov [Ref%],eax       ;Ref% calculation
      
      mov eax,[Xnum%]      ;Ref1% calculation
      mov ebx,[b%]
      dec ebx
      mul ebx
      mov ebx,[a%]
      dec ebx
      add eax,ebx
      shl eax,3
      mov [Ref1%],eax      ;Ref1% calculation
      
      finit
      mov eax,[Ref%]
      add eax,[XtSize%]
      fld qword Vt0%[eax]
      add eax,[XtSize%]
      fld qword Vt0%[eax]
      faddp st1,st0
      fld qword [Fac%]
      fmulp st1,st0
      mov eax,[Ref%]
      fld qword Vt0%[eax]
      faddp st1,st0
      mov eax,[Ref1%]
      fstp qword Vt1%[eax]
      
      mov eax,[b%]
      cmp eax,[Ynum%]
      jl near dgain
      
      mov eax,[a%]
      cmp eax,[Xnum%]
      jl near cgain
      
      ret
      ]
      endproc
      
      rem Estimation using 2nd order PD Calculations
      def proc_dump4
      for a%=1 to !Xnum%
        for b%=1 to !Ynum%
          !Ref%=8*(b%*(!Xnum%+2) + a%) : rem Done
          !Ref1%=8*((b%-1)*!Xnum% + (a%-1)) : rem Done
          rem Following Done
          |(Vt1%+!Ref1%)=|(Vt0%+!Ref%) + (|Fac%)*(|(Vt0%+!Ref%+!XtSize%) + |(Vt0%+!Ref%+(2*!XtSize%)))
        next b%
      next a%
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Assembly Language Routine 5
      rem Estimation of 2nd order PD Routine
      def proc_pd2(opt%)
      P%=pd2%
      [opt opt%
      
      mov eax,0                ;Initialise aa-loop control
      mov [aa%],eax
      .egain
      inc dword [aa%]
      
      mov eax,0                ;Initialise bb-loop control
      mov [bb%],eax
      .fgain
      inc dword [bb%]
      
      mov eax,[Xnum%]      ;Ref% calculation
      add eax,2
      mov ebx,[bb%]
      mul ebx
      add eax,[aa%]
      shl eax,3
      mov [Ref%],eax       ;Ref% calculation
      
      mov eax,[Xnum%]      ;Refu% calculation
      add eax,2
      mov ebx,[bb%]
      mul ebx
      add eax,[aa%]
      inc eax
      shl eax,3
      mov [Refu%],eax       ;Refu% calculation
      
      mov eax,[Xnum%]      ;Refd% calculation
      add eax,2
      mov ebx,[bb%]
      mul ebx
      add eax,[aa%]
      dec eax
      shl eax,3
      mov [Refd%],eax       ;Refd% calculation
      
      finit
      mov eax,[Refu%]
      fld qword Vt0%[eax]
      mov eax,[Refd%]
      fld qword Vt0%[eax]
      faddp st1,st0
      mov eax,[Ref%]
      fld qword Vt0%[eax]
      fsub st1,st0
      fsubp st1,st0
      add eax,[XtSize%]
      fstp qword Vt0%[eax]
      
      mov eax,[Xnum%]      ;Refu% calculation
      add eax,2
      mov ebx,[bb%]
      inc ebx
      mul ebx
      add eax,[aa%]
      shl eax,3
      mov [Refu%],eax       ;Refu% calculation
      
      mov eax,[Xnum%]      ;Refd% calculation
      add eax,2
      mov ebx,[bb%]
      dec ebx
      mul ebx
      add eax,[aa%]
      shl eax,3
      mov [Refd%],eax       ;Refd% calculation
      
      mov eax,[Refu%]
      fld qword Vt0%[eax]
      mov eax,[Refd%]
      fld qword Vt0%[eax]
      faddp st1,st0
      mov eax,[Ref%]
      fld qword Vt0%[eax]
      fsub st1,st0
      fsubp st1,st0
      add eax,[XtSize%]
      add eax,[XtSize%]
      fstp qword Vt0%[eax]
      
      mov eax,[bb%]
      cmp eax,[Ynum%]
      jl near fgain
      
      mov eax,[aa%]
      cmp eax,[Xnum%]
      jl near egain
      
      ret
      ]
      endproc
      
      rem Estimation of 2nd order PD Calculations
      def proc_dump5
      !Ref%=8*(!y%*(!Xnum%+2) + !x%) : rem Done
      
      !Refu%=8*(!bb%*(!Xnum%+2) + (!aa%+1)) : rem Done
      !Refd%=8*(!bb%*(!Xnum%+2) + (!aa%-1)) : rem Done
      rem Following Done
      |(Vt0%+!Ref%+!XtSize%)=|(Vt0%+!Refu%) - 2*(|(Vt0%+!Ref%)) + |(Vt0%+!Refd%)
      
      !Refu%=8*((y%+1)*(!Xnum%+2) + x%) : rem Done
      !Refd%=8*((y%-1)*(!Xnum%+2) + x%) : rem Done
      rem Following Done
      |(Vt0%+!Ref%+(2*!XtSize%))=|(Vt0%+!Refu%) - 2*(|(Vt0%+!Ref%)) + |(Vt0%+!Refd%)
      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 ===============================================================