Source Code for program Ising, version 1.1, 22 September 2002 Copyright 2002, Dan Schroeder Physics Department, Weber State University, Ogden, UT 84408-2508. http://physics.weber.edu/schroeder/ This program is free, open-source software. You can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, contact the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA, www.gnu.org. ----- Edit history ----- Version 1.1, 22 September 2002 Fixed bug in FileOpen with radio buttons and checkbox being set incorrectly. Sped up graphics in OSX using LockPortBits and QDSetDirtyRegion. First two bytes of save file are now "IS" so we can check to be sure the save file isn't from another program. This means that version 1.0 save files cannot be opened. Creator code is now "Isng", as registered with Apple. ----- Version 1.0, 4 September 2002 ------------------------------------------------------------ App Properties: Bfield as Double continuous as Boolean DownColor as Color Ecurrent as Double // energy EsquaredTotal as Double Etotal as Double GWindowPort as Integer // used to speed up graphics under OSX GWindowRegion as Integer // ditto InitialState as String InnerLoopCount as Integer // number of times we've executed inner loop LoopsBeforeUpdate as Integer // how often to update periodically LoopsSinceUpdate as Integer Mcurrent as Double // magnetization MsquaredTotal as Double Mtotal as Double pbc as Boolean s(399,399) as Integer // array of spin values (1 for up, -1 for down) Size as Integer // width of array, from 2 to 400 SquareWidth as Integer // width of squares in pixels StepsPerLoop as Integer T as Double // temperature UpColor as Color App.Open: Sub Open() #if TargetCarbon Declare function GetWindowPort lib "CarbonLib" (window as WindowPtr) as integer Declare function NewRgn lib "CarbonLib" as integer Declare sub SetRectRgn lib "CarbonLib" (region as integer, left as short, top as short, right as short, bottom as short) #endif StepsPerLoop = 100 // iterations before we cumulate stats and look at clock (must be multiple of 100) LoopsBeforeUpdate = 4000000 / StepsPerLoop // 4 million steps before periodic redraw Size = 100 // lattice size (must agree with popup menu initial value) SquareWidth = 400 / Size GraphicsWindow.Graphics.PenHeight = SquareWidth GraphicsWindow.Graphics.PenWidth = SquareWidth UpColor = RGB(75,75,185) DownColor = RGB(255,255,180) ControlWindow.Rectangle1.FillColor = UpColor ControlWindow.Rectangle2.FillColor = DownColor #if TargetPPC ControlWindow.HasBackColor = True // gray looks better in OS9 ControlWindow.Backcolor = RGB(238,238,238) ControlWindow.ListBox1.Left = ControlWindow.ListBox1.Left + 3 // wider font needs more space ControlWindow.StaticText4.Left = ControlWindow.StaticText4.Left + 4 ControlWindow.StaticText5.Left = ControlWindow.StaticText5.Left + 4 ControlWindow.StaticText6.Left = ControlWindow.StaticText6.Left + 4 ControlWindow.StaticText7.Left = ControlWindow.StaticText7.Left + 4 ControlWindow.StaticText8.Left = ControlWindow.StaticText8.Left + 4 ControlWindow.StaticText9.Left = ControlWindow.StaticText9.Left + 4 ControlWindow.StaticText10.Left = ControlWindow.StaticText10.Left + 4 #endif #if TargetWin32 ControlWindow.RadioButton1.Left = ControlWindow.RadioButton1.Left + 8 ControlWindow.RadioButton2.Left = ControlWindow.RadioButton2.Left + 8 ControlWindow.CheckBox1.Left = ControlWindow.CheckBox1.Left + 8 #endif T = 2.27 // start at critical temperature Bfield = 0.0 pbc = True // use periodic boundary conditions continuous = True // update screen continuously InitialState = "random" Initialize GraphicsWindow.Left = screen(0).width/2 - 306 GraphicsWindow.Top = 54 ControlWindow.Left = GraphicsWindow.Left + 412 ControlWindow.Top = GraphicsWindow.Top GraphicsWindow.Show ControlWindow.Show #if TargetCarbon GWindowPort = GetWindowPort(GraphicsWindow) GWindowRegion = NewRgn() SetRectRgn GWindowRegion,0,0,400,400 #endif End Sub App.Initialize: Sub Initialize() Dim i,j as Integer #if TargetCarbon Declare Function Random Lib "CarbonLib" as Short #endif #if TargetPPC Declare Function Random Lib "InterfaceLib" as Short #endif #pragma disableBackgroundTasks // for speed Select Case InitialState Case "up" For i = 0 to Size-1 For j = 0 to Size-1 s(i,j) = 1 Next Next Case "down" For i = 0 to Size-1 For j = 0 to Size-1 s(i,j) = -1 Next Next Case "random" For i = 0 to Size-1 For j = 0 to Size-1 #if TargetMacOS If Random() < 0 then // use faster RNG in MacOS s(i,j) = 1 Else s(i,j) = -1 End if #else If Rnd < 0.5 then s(i,j) = 1 Else s(i,j) = -1 End if #endif Next Next End select ComputeE ResetStats DisplayData LoopsSinceUpdate= 0 End Sub App.RunSimulation: Sub RunSimulation() Dim StartTime, FlushTime as Double Dim junk as integer #if TargetCarbon declare sub QDSetDirtyRegion lib "CarbonLib" (port as integer, region as integer) declare sub LockPortBits lib "CarbonLib" (port as integer) declare sub UnlockPortBits lib "CarbonLib" (port as integer) #endif StartTime = Microseconds FlushTime = StartTime Do If continuous then #if TargetCarbon LockPortBits GWindowPort // tricks to speed up graphics on OS X QDSetDirtyRegion GWindowPort, GWindowRegion #endif Do MetropolisG Cumulate Loop until (Microseconds - FlushTime) > 25000.0 // update screen after 0.025 seconds #if TargetCarbon UnlockPortBits GWindowPort #endif GraphicsWindow.UpdateNow // (applies only to OSX with its offscreen graphics buffer) FlushTime = Microseconds Else Metropolis Cumulate End if Loop until (Microseconds - StartTime) > 200000.0 // run for .2 seconds // (changing this to .1 seconds slows it down by nearly 10% on my machine) DisplayData End Sub App.MetropolisG: Sub MetropolisG() // This version executes ColorSquare every time a dipole flips Dim i,j,thisS as Integer Dim Ediff as Double Dim count as integer #if TargetCarbon Declare Function Random Lib "CarbonLib" as Short #endif #if TargetPPC Declare Function Random Lib "InterfaceLib" as Short #endif #pragma disableBackgroundTasks // we need speed here for count = 1 to StepsPerLoop i = RandInt(Size) j = RandInt(Size) thisS = s(i,j) Ediff = deltaU(i,j,thisS) If Ediff <= 0.0 then thisS = -thisS s(i,j) = thisS ColorSquare(i,j,thisS) Ecurrent = Ecurrent + Ediff Mcurrent = Mcurrent + 2*thisS Else #if TargetMacOS If (Random() + 32767) < 65535.0*exp(-Ediff/T) then // check constants! thisS = -thisS s(i,j) = thisS ColorSquare(i,j,thisS) Ecurrent = Ecurrent + Ediff Mcurrent = Mcurrent + 2*thisS End if #else If Rnd < exp(-Ediff/T) then // on Windows, use RB's slower RNG thisS = -thisS s(i,j) = thisS ColorSquare(i,j,thisS) Ecurrent = Ecurrent + Ediff Mcurrent = Mcurrent + 2*thisS End if #endif End if next InnerLoopCount = InnerLoopCount + 1 End Sub App.Metropolis: Sub Metropolis() // This version causes screen updating only periodically Dim i,j,thisS as Integer Dim Ediff as Double Dim count as integer #if TargetCarbon Declare Function Random Lib "CarbonLib" as Short #endif #if TargetPPC Declare Function Random Lib "InterfaceLib" as Short #endif #pragma disableBackgroundTasks // we need speed here for count = 1 to StepsPerLoop i = RandInt(Size) j = RandInt(Size) thisS = s(i,j) Ediff = deltaU(i,j,thisS) If Ediff <= 0.0 then s(i,j) = -thisS Ecurrent = Ecurrent + Ediff Mcurrent = Mcurrent - 2*thisS Else #if TargetMacOS If (Random() + 32767) < 65535.0*exp(-Ediff/T) then // check constants! s(i,j) = -thisS Ecurrent = Ecurrent + Ediff Mcurrent = Mcurrent - 2*thisS End if #else If Rnd < exp(-Ediff/T) then // on Windows, use RB's slower RNG s(i,j) = -thisS Ecurrent = Ecurrent + Ediff Mcurrent = Mcurrent - 2*thisS End if #endif End if next InnerLoopCount = InnerLoopCount + 1 LoopsSinceUpdate = LoopsSinceUpdate + 1 if LoopsSinceUpdate >= LoopsBeforeUpdate then LoopsSinceUpdate = 0 DisplayData // just so the number will be accurate as it pauses to draw ColorAll End if End Sub App.deltaU: Function deltaU(i as Integer, j as Integer, thisS as Integer) As Double Dim left, right, top, bottom as Integer #pragma disableBackgroundTasks // i don't think this has any effect If i = 0 then if pbc then top = s(size-1,j) else top = 0 end if else top = s(i-1,j) end if If i = size-1 then if pbc then bottom = s(0,j) else bottom = 0 end if else bottom = s(i+1,j) end if If j = 0 then if pbc then left = s(i,size-1) else left = 0 end if else left = s(i,j-1) end if If j = size-1 then if pbc then right = s(i,0) else right = 0 end if else right = s(i,j+1) end if Return 2.0 * thisS * (top+bottom+left+right+Bfield) End Function App.ColorSquare: Sub ColorSquare(i as Integer, j as Integer, thisS as Integer) Dim x, y as Integer If thisS = 1 then GraphicsWindow.Graphics.ForeColor = UpColor Else GraphicsWindow.Graphics.ForeColor = DownColor End if x = i * SquareWidth y = j * SquareWidth #if TargetWin32 GraphicsWindow.Graphics.FillRect x, y, SquareWidth, SquareWidth #else GraphicsWindow.Graphics.DrawLine x, y, x, y // faster than FillRect but looks bad on Windows #endif End Sub App.ColorAll: Sub ColorAll() Dim i,j as Integer #pragma disableBackgroundTasks // for speed For i = 0 to Size - 1 For j = 0 to Size - 1 ColorSquare(i,j,s(i,j)) Next Next End Sub App.DisplayData: Sub DisplayData() Dim Eav, Esquaredav, SigmaE, Mav, Msquaredav, SigmaM, size2 as Double If InnerLoopCount = 0 then Eav = 0 SigmaE = 0 Mav = 0 SigmaM = 0 Else Eav = Etotal / InnerLoopCount Esquaredav = EsquaredTotal / InnerLoopCount SigmaE = sqrt(Esquaredav - Eav*Eav) Mav = Mtotal / InnerLoopCount Msquaredav = MsquaredTotal / InnerLoopCount SigmaM = sqrt(Msquaredav - Mav*Mav) End if size2 = Size * Size ControlWindow.ListBox1.List(0) = Format(InnerLoopCount*(StepsPerLoop/100),"#")+"00" ControlWindow.ListBox1.List(1) = Format(Ecurrent/size2,"-#.000") ControlWindow.ListBox1.List(2) = Format(Eav/size2, "-#.000") ControlWindow.ListBox1.List(3) = Format(SigmaE/size2, "-#.000") ControlWindow.ListBox1.List(4) = Format(Mcurrent/size2,"-#.000") ControlWindow.ListBox1.List(5) = Format(Mav/size2, "-#.000") ControlWindow.ListBox1.List(6) = Format(SigmaM/size2, "-#.000") End Sub App.ComputeE: Sub ComputeE() // computes energy and magnetization from scratch // this routine could be faster, but it's not used often Dim i,j,thisS as Integer Dim bottom, right as integer #pragma disableBackgroundTasks // for speed Ecurrent = 0.0 Mcurrent = 0.0 For i = 0 to Size-1 For j = 0 to Size-1 if i = Size-1 then // bottom row gets special treatment if pbc then bottom = s(0,j) Else bottom = 0 End if Else bottom = s(i+1,j) End if if j = Size-1 then // as does right column if pbc then right = s(i,0) Else right = 0 End if Else right = s(i,j+1) End if thisS = s(i,j) Ecurrent = Ecurrent - thisS*(right+bottom+Bfield) Mcurrent = Mcurrent + thisS Next Next End Sub App.ResetStats: Sub ResetStats() InnerLoopCount = 0 Etotal = 0 EsquaredTotal = 0 Mtotal = 0 MsquaredTotal = 0 DisplayData End Sub App.Resize: Sub Resize(NewSize as Integer) Dim TempS(399,399) as Integer Dim TempSize as Integer Dim i,j,i0,j0 as Integer Dim ratio as Integer #pragma disableBackgroundTasks TempSize = LCM(Size,NewSize) // find least common multiple of new and old sizes ratio = TempSize / Size For i = 0 to TempSize - 1 For j = 0 to TempSize - 1 TempS(i,j) = s(i/ratio,j/ratio) // scale array up to TempSize Next Next ratio = TempSize / NewSize For i = 0 to NewSize - 1 For j = 0 to NewSize - 1 s(i,j) = 0 Next Next For i = 0 to TempSize - 1 for j = 0 to TempSize - 1 i0 = i / ratio j0 = j / ratio s(i0,j0) = s(i0,j0) + TempS(i,j) // sum all values that get put into new Next Next For i = 0 to NewSize - 1 For j = 0 to NewSize - 1 If s(i,j) > 0 then s(i,j) = 1 // majority rule determines new value Else If s(i,j) < 0 then s(i,j) = -1 Else If Rnd > 0.5 then // if no majority, decide randomly s(i,j) = 1 Else s(i,j) = -1 End if End if End if Next Next Size = NewSize SquareWidth = 400 / Size GraphicsWindow.Graphics.PenHeight = SquareWidth GraphicsWindow.Graphics.PenWidth = SquareWidth ComputeE ResetStats DisplayData LoopsSinceUpdate = 0 // reset number of passes since last draw ColorAll // redraw window End Sub App.LCM: Function LCM(size1 as integer, size2 as integer) As integer // returns least common multiple of size1, size2 // (we know both arguments are factors of 400) // this routine is called by Resize Dim answer as integer answer = 400 If (200 mod size1 = 0) and (200 mod size2 = 0) then answer = 200 End if If (100 mod size1 = 0) and (100 mod size2 = 0) then answer = 100 End if If (80 mod size1 = 0) and (80 mod size2 = 0) then answer = 80 End if If (50 mod size1 = 0) and (50 mod size2 = 0) then answer = 50 End if If (40 mod size1 = 0) and (40 mod size2 = 0) then answer = 40 End if If (25 mod size1 = 0) and (25 mod size2 = 0) then answer = 25 End if If (20 mod size1 = 0) and (20 mod size2 = 0) then answer = 20 End if If (16 mod size1 = 0) and (16 mod size2 = 0) then answer = 16 End if If (10 mod size1 = 0) and (10 mod size2 = 0) then answer = 10 End if If (8 mod size1 = 0) and (8 mod size2 = 0) then answer = 8 End if If (4 mod size1 = 0) and (4 mod size2 = 0) then answer = 4 End if Return answer End Function App.Cumulate: Sub Cumulate() Etotal = Etotal + Ecurrent // cumulate stats EsquaredTotal = EsquaredTotal + (Ecurrent * Ecurrent) Mtotal = Mtotal + Mcurrent MsquaredTotal = MsquaredTotal + (Mcurrent * Mcurrent) End Sub App.RandInt: Function RandInt(n as Integer) As Integer // returns a random integer between 0 and n-1 (inclusive) #if TargetCarbon Declare Function Random Lib "CarbonLib" as Short #endif #if TargetPPC Declare Function Random Lib "InterfaceLib" as Short #endif Dim temp as Integer #if TargetMacOS temp = Random() // about 5x faster than Rnd, but use with caution! temp = (temp + 32767) * n \ 65535 #else temp = Rnd * n // on windows, just use RB's built-in function #endif Return temp End Function App.Deactivate: Sub Deactivate() ControlWindow.Hide End Sub App.Activate: Sub Activate() ControlWindow.Show End Sub App.EnableMenuItems: Sub EnableMenuItems() AppleAboutIsing.Enable FileOpen.Enable FileSave.Enable FileSavePicture.Enable If ControlWindow.ListBox1.SelCount > 0 then EditCopy.Enable End if If ControlWindow.ListBox1.SelCount < 7 then EditSelectAll.Enable End if End Sub App.OpenTheFile: Sub OpenTheFile(f as FolderItem) Dim stream as BinaryStream Dim firstbyte, secondbyte, version, subversion as Integer Dim r,g,b as Integer Dim i,j as Integer Dim TempBoolean as Boolean #pragma disableBackgroundTasks // so the for loops won't take forever If f <> Nil then stream = f.OpenAsBinaryFile(False) firstbyte = stream.ReadByte // first two bytes must be ASCII "IS" for Ising secondbyte = stream.ReadByte version = stream.ReadByte subversion = stream.ReadByte If (firstbyte <> 73) or (secondbyte <> 83) or (version <> 1) or (subversion <> 1) then MsgBox "Sorry, can't read that file." Else Size = stream.ReadShort Select Case Size Case 2 ControlWindow.PopupMenu1.ListIndex = 0 Case 4 ControlWindow.PopupMenu1.ListIndex = 1 Case 5 ControlWindow.PopupMenu1.ListIndex = 2 Case 8 ControlWindow.PopupMenu1.ListIndex = 3 Case 10 ControlWindow.PopupMenu1.ListIndex = 4 Case 16 ControlWindow.PopupMenu1.ListIndex = 5 Case 20 ControlWindow.PopupMenu1.ListIndex = 6 Case 25 ControlWindow.PopupMenu1.ListIndex = 7 Case 40 ControlWindow.PopupMenu1.ListIndex = 8 Case 50 ControlWindow.PopupMenu1.ListIndex = 9 Case 80 ControlWindow.PopupMenu1.ListIndex = 10 Case 100 ControlWindow.PopupMenu1.ListIndex = 11 Case 200 ControlWindow.PopupMenu1.ListIndex = 12 Case 400 ControlWindow.PopupMenu1.ListIndex = 13 End Select TempBoolean = stream.ReadBoolean // pbc If TempBoolean then ControlWindow.CheckBox1.Value = True Else ControlWindow.CheckBox1.Value = False End if pbc = TempBoolean TempBoolean = stream.ReadBoolean // continuous If TempBoolean then ControlWindow.RadioButton1.Value = True ControlWindow.RadioButton2.Value = False Else ControlWindow.RadioButton1.Value = False ControlWindow.RadioButton2.Value = True End if r = stream.ReadByte g = stream.ReadByte b = stream.ReadByte upColor = RGB(r,g,b) ControlWindow.Rectangle1.FillColor = UpColor r = stream.ReadByte g = stream.ReadByte b = stream.ReadByte downColor = RGB(r,g,b) ControlWindow.Rectangle2.FillColor = DownColor T = stream.ReadDouble ControlWindow.StaticText1.Text = "Temperature = "+Format(T,"#.00") Bfield = stream.ReadDouble If Abs(Bfield) < 0.001 then ControlWindow.StaticText2.Text = "Magnetic field = 0.00" Else ControlWindow.StaticText2.Text = "Magnetic field = "+Format(Bfield,"+#.00") End if InnerLoopCount = stream.ReadLong Ecurrent = stream.ReadDouble Etotal = stream.ReadDouble EsquaredTotal = stream.ReadDouble Mcurrent = stream.ReadDouble Mtotal = stream.ReadDouble MsquaredTotal = stream.ReadDouble For i = 0 to Size-1 For j = 0 to Size-1 s(i,j) = stream.ReadShort Next Next SquareWidth = 400 / Size GraphicsWindow.Graphics.PenHeight = SquareWidth GraphicsWindow.Graphics.PenWidth = SquareWidth ColorAll DisplayData End if stream.Close End if End Sub App.OpenDocument: Sub OpenDocument(item As FolderItem) OpenTheFile(item) End Sub App.AppleAboutIsing: Function Action As Boolean AboutWindow.BackColor = DownColor AboutWindow.StaticText1.TextColor = UpColor AboutWindow.StaticText2.TextColor = UpColor AboutWindow.StaticText3.TextColor = UpColor AboutWindow.StaticText4.TextColor = UpColor AboutWindow.StaticText5.TextColor = UpColor AboutWindow.StaticText6.TextColor = UpColor AboutWindow.StaticText7.TextColor = UpColor AboutWindow.StaticText8.TextColor = UpColor AboutWindow.Show End Function App.EditCopy: Function Action As Boolean Dim RowNum as Integer Dim c as Clipboard Dim copyList as String c = New Clipboard For RowNum = 0 to 6 If ControlWindow.ListBox1.Selected(RowNum) Then copyList = copyList + ControlWindow.ListBox1.List(RowNum)+Chr(13) End if Next c.SetText copyList c.Close End Function App.EditSelectAll Function Action As Boolean Dim RowNum as Integer For RowNum = 0 to 6 ControlWindow.ListBox1.Selected(RowNum) = True Next End Function App.FileOpen Function Action As Boolean Dim f as FolderItem #if TargetWin32 ControlWindow.Hide f = GetOpenFolderItem("IsingSaveFile;All Types (*.*)") ControlWindow.Show #else f = GetOpenFolderItem("IsingSaveFile") #endif If f <> Nil then OpenTheFile(f) End if End Function App.FileSave Function Action As Boolean Dim f as FolderItem Dim stream as BinaryStream Dim i,j as Integer #pragma disableBackgroundTasks // so the for loops won't take forever #if TargetWin32 ControlWindow.Hide f = GetSaveFolderItem("IsingSaveFile","Untitled.isng") ControlWindow.Show #else f = GetSaveFolderItem("IsingSaveFile","Untitled") #endif If f <> Nil then stream = f.CreateBinaryFile("IsingSaveFile") stream.WriteByte(73) // ASCII "I" to identify Ising program stream.WriteByte(83) // ASCII "S" to identify Ising program stream.WriteByte(1) // main version number stream.WriteByte(1) // sub-version number stream.WriteShort(Size) stream.WriteBoolean(pbc) stream.WriteBoolean(continuous) stream.WriteByte(upColor.red) stream.WriteByte(upColor.green) stream.WriteByte(upColor.blue) stream.WriteByte(downColor.red) stream.WriteByte(downColor.green) stream.WriteByte(downColor.blue) stream.WriteDouble(T) stream.WriteDouble(Bfield) stream.WriteLong(InnerLoopCount) stream.WriteDouble(Ecurrent) stream.WriteDouble(Etotal) stream.WriteDouble(EsquaredTotal) stream.WriteDouble(Mcurrent) stream.WriteDouble(Mtotal) stream.WriteDouble(MsquaredTotal) For i = 0 to Size-1 For j = 0 to Size-1 stream.WriteShort(s(i,j)) Next Next stream.Close End if End Function App.FileSavePicture Function Action As Boolean Dim f as FolderItem Dim offscreenimage as Picture // for some reason we can't just use GraphicsWindow.Graphics Dim i,j,x,y as Integer #pragma disableBackgroundTasks // so the for loops won't take forever #if TargetMacOS f = GetSaveFolderItem("image/x-pict","Untitled") #else ControlWindow.Hide f = GetSaveFolderItem("image/x-bmp","Untitled") ControlWindow.Show #endif If f <> Nil then offscreenimage = NewPicture(400,400,32) offscreenimage.Graphics.PenHeight = SquareWidth offscreenimage.Graphics.PenWidth = SquareWidth For i = 0 to Size-1 For j = 0 to Size-1 If s(i,j) = 1 then offscreenimage.Graphics.ForeColor = upColor Else offscreenimage.Graphics.ForeColor = downColor End if x = i * SquareWidth y = j * SquareWidth #if TargetWin32 offscreenimage.Graphics.FillRect x,y,SquareWidth,SquareWidth #else offscreenimage.Graphics.DrawLine x,y,x,y // faster but ugly on windows #endif Next Next f.SaveAsPicture offscreenimage,4 // the 4 gives raster PICT on Mac, BMP on Window End if End Function ------------------------------------------------------------ ControlWindow properties: LastBdownTime as Double LastBupTime as Double LastTdownTime as Double LastTupTime as Double ControlWindow.LowerTemp: Sub LowerTemp() Dim NowTime, ClickInterval, deltaT as Double NowTime = Microseconds ClickInterval = (NowTIme - LastTdownTime) / 1000000.0 If ClickInterval > 0.5 then deltaT = 0.01 Else If ClickInterval > 0.3 then deltaT = 0.03 Else If ClickInterval > 0.15 then deltaT = 0.1 Else deltaT = 0.3 End if End if End if App.T = App.T - deltaT If App.T < 0.01 then App.T = 0.01 End if Self.StaticText1.Text = "Temperature = "+Format(App.T,"#.00") LastTdownTime = NowTime End Sub ControlWindow.RaiseTemp: Sub RaiseTemp() Dim NowTime, ClickInterval, deltaT as Double NowTime = Microseconds ClickInterval = (NowTIme - LastTupTime) / 1000000.0 If ClickInterval > 0.5 then deltaT = 0.01 Else If ClickInterval > 0.3 then deltaT = 0.03 Else If ClickInterval > 0.15 then deltaT = 0.1 Else deltaT = 0.3 End if End if End if App.T = App.T + deltaT If App.T > 9.99 then App.T = 9.99 End if Self.StaticText1.Text = "Temperature = "+Format(App.T,"#.00") LastTupTime = NowTime End Sub ControlWindow.LowerB: Sub LowerB() Dim NowTime, ClickInterval, deltaB as Double NowTime = Microseconds ClickInterval = (NowTIme - LastBdownTime) / 1000000.0 If ClickInterval > 0.5 then deltaB = 0.01 Else If ClickInterval > 0.3 then deltaB = 0.03 Else If ClickInterval > 0.15 then deltaB = 0.1 Else deltaB = 0.3 End if End if End if If (App.Bfield > 0.0) and (App.Bfield - deltaB < 0.001) then deltaB = App.Bfield // pause at zero End if App.Bfield = App.Bfield - deltaB If Abs(App.Bfield) < 0.001 then Self.StaticText2.Text = "Magnetic field = 0.00" Else Self.StaticText2.Text = "Magnetic field = "+Format(App.Bfield,"+#.00") End if LastBdownTime = NowTime App.Ecurrent = App.Ecurrent + deltaB*App.Mcurrent App.DisplayData End Sub ControlWindow.RaiseB: Sub RaiseB() Dim NowTime, ClickInterval, deltaB as Double NowTime = Microseconds ClickInterval = (NowTIme - LastBupTime) / 1000000.0 If ClickInterval > 0.5 then deltaB = 0.01 Else If ClickInterval > 0.3 then deltaB = 0.03 Else If ClickInterval > 0.15 then deltaB = 0.1 Else deltaB = 0.3 End if End if End if If (App.Bfield < 0.0) and (App.Bfield + deltaB > -0.001) then deltaB = -App.Bfield // pause at zero End if App.Bfield = App.Bfield + deltaB If Abs(App.Bfield) < 0.001 then Self.StaticText2.Text = "Magnetic field = 0.00" Else Self.StaticText2.Text = "Magnetic field = "+Format(App.Bfield,"+#.00") End if LastBupTime = NowTime App.Ecurrent = App.Ecurrent - deltaB*App.Mcurrent App.DisplayData End Sub ControlWindow.KeyDown: Function KeyDown(Key As String) As Boolean // on MacOS, key events never go to a floating window, i think // but on Windows it seems that they do, so... Select Case Key Case chr(28) // left arrow ControlWindow.LowerB Case "D" // for "down" ControlWindow.LowerB Case chr(29) // right arrow ControlWindow.RaiseB Case "U" // for "up" ControlWindow.RaiseB Case chr(30) // up arrow ControlWindow.RaiseTemp Case "H" // for "hotter" ControlWindow.RaiseTemp Case chr(31) // down arrow ControlWindow.LowerTemp Case "C" // for "colder" ControlWindow.LowerTemp Case "S" ControlWindow.GoButton.Push Case chr(13) // return key ControlWindow.GoButton.Push End Select End Function ControlWindow.GoButton.Action: Sub Action() Me.Default = False // no more throbbing after first press If Self.Timer1.Mode = 0 then Self.Timer1.Mode = 2 Me.Caption = "Stop" Else Self.Timer1.Mode = 0 Me.Caption = "Start" End if 'BackgroundThread1.Run End Sub ControlWindow.LittleArrows1.Up: Sub Up() RaiseTemp End Sub ControlWindow.LittleArrows1.Down: Sub Down() LowerTemp End Sub ControlWindow.LittleArrows2.Up: Sub Up() RaiseB End Sub ControlWindow.LittleArrows2.Down: Sub Down() LowerB End Sub ControlWindow.PopupMenu1.Change: Sub Change() Dim NewSize as Integer Select Case Me.ListIndex Case 0 NewSize = 2 Case 1 NewSize = 4 Case 2 NewSize = 5 Case 3 NewSize = 8 Case 4 NewSize = 10 Case 5 NewSize = 16 Case 6 NewSize = 20 Case 7 NewSize = 25 Case 8 NewSize = 40 Case 9 NewSize = 50 Case 10 NewSize = 80 Case 11 NewSize = 100 Case 12 NewSize = 200 Case 13 NewSize = 400 End Select App.Resize(NewSize) End Sub ControlWindow.PushButton1.Action: Sub Action() App.InitialState = "random" App.Initialize App.ColorAll End Sub ControlWindow.CheckBox1.Action: Sub Action() If App.pbc then App.pbc = False Else App.pbc = True End if App.ComputeE // gotta recompute the energy App.ResetStats End Sub ControlWindow.RadioButton1.Action: Sub Action() App.continuous = True App.ColorAll Me.Value = True Self.RadioButton2.Value = False End Sub ControlWindow.RadioButton2.Action: Sub Action() App.continuous = False App.LoopsSinceUpdate = 0 Me.Value = True Self.RadioButton1.Value = False End Sub ControlWindow.PushButton2.Action: Sub Action() If App.s(0,0) = 1 then App.InitialState = "down" Else App.InitialState = "up" End if App.Initialize App.ColorAll End Sub ControlWindow.TabPanel1.MouseDown: Function MouseDown(X As Integer, Y As Integer) As Boolean Dim i as Integer For i = 0 to 6 Self.ListBox1.Selected(i) = False Next End Function ControlWindow.PushButton3.Action: Sub Action() App.ResetStats End Sub ControlWindow.ListBox1.Open: Sub Open() Dim i as Integer For i = 0 to 6 Me.CellAlignment(i,0) = 3 Next End Sub ControlWindow.BevelButton1.Action: Sub Action() Dim theColor as Color Dim b as Boolean theColor = App.UpColor b = SelectColor(theColor,"Select a color") Self.Rectangle1.FillColor = theColor App.UpColor = theColor App.ColorAll End Sub ControlWindow.BevelButton2.Action: Sub Action() Dim theColor as Color Dim b as Boolean theColor = App.DownColor b = SelectColor(theColor,"Select a color") Self.Rectangle2.FillColor = theColor App.DownColor = theColor App.ColorAll End Sub ControlWindow.Timer1.Action: Sub Action() App.RunSimulation End Sub ------------------------------------------------------------ GraphicsWindow properties: ChangeTo as Integer GraphicsWindow.FlipDipole: Sub FlipDipole(x as Integer, y as Integer) Dim i,j as Integer i = x / App.SquareWidth j = y / App.SquareWidth If i >= 0 and j >= 0 and i < App.Size and j < App.Size then If App.s(i,j) <> ChangeTo then App.Ecurrent = App.Ecurrent + App.DeltaU(i,j,App.s(i,j)) App.s(i,j) = -App.s(i,j) App.Mcurrent = App.Mcurrent + 2.0*App.s(i,j) App.ColorSquare(i,j,App.s(i,j)) ChangeTo = App.s(i,j) End if End if End Sub GraphicsWindow.Moved: Sub Moved() If Me.Left < screen(0).width/2 - 200 then ControlWindow.Left = Me.Left + 412 Else ControlWindow.Left = Me.Left - 216 End if ControlWindow.Top = Me.Top End Sub GraphicsWindow.KeyDown: Function KeyDown(Key As String) As Boolean Select Case Key Case chr(28) // left arrow ControlWindow.LowerB Case "D" // for "down" ControlWindow.LowerB Case chr(29) // right arrow ControlWindow.RaiseB Case "U" // for "up" ControlWindow.RaiseB Case chr(30) // up arrow ControlWindow.RaiseTemp Case "H" // for "hotter" ControlWindow.RaiseTemp Case chr(31) // down arrow ControlWindow.LowerTemp Case "C" // for "colder" ControlWindow.LowerTemp Case "S" ControlWindow.GoButton.Push Case chr(13) // return key ControlWindow.GoButton.Push End Select End Function GraphicsWindow.MouseDown: Function MouseDown(X As Integer, Y As Integer) As Boolean ChangeTo = 0 // so we're sure to change the first one FlipDipole(x,y) Return True End Function GraphicsWindow.MouseDrag: Sub MouseDrag(X As Integer, Y As Integer) FlipDipole(x,y) End Sub GraphicsWindow.MouseUp: Sub MouseUp(X As Integer, Y As Integer) App.DisplayData End Sub GraphicsWindow.Paint: Sub Paint(g As Graphics) App.ColorAll End Sub ------------------------------------------------------------ AboutWindow.MouseDown: Function MouseDown(X As Integer, Y As Integer) As Boolean Me.Hide End Function AboutWindow.CloseButton.Action: Sub Action() Self.Close End Sub AboutWindow.NextButton.Action: Sub Action() If Self.PagePanel1.Value = 5 then Self.PagePanel1.Value = 0 Else Self.PagePanel1.Value = Self.PagePanel1.Value + 1 End if End Sub ------------------------------------------------------------