Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me.
|
Forum Index : Microcontroller and PC projects : MM 1st project Ambient conditions Monitor
Author | Message | ||||
Andrew_G Guru Joined: 18/10/2016 Location: AustraliaPosts: 840 |
I've finally finished a first draft of my first MM project. Please be gentle (but constructive feedback is very welcome) I have, for want of anything better, called it Ambi-Mon (Ambient Conditions Monitor). It uses a 28 pin MM on the LCD Backpack, an RTC, a BMP180 and three DS18B20. It has four main displays: A digital display of UTC in a large font (hh:mm:ss), date (dd mmm yyyy) and day of the week An analogue display of local time, date (ddd ddmmm), digital time (hh:mm) and ambient temperature (ēC) A bar graph of the ambient Barometric Pressure for each of the last 3 hours (measured every 15 minutes) and hourly averages over the last 10 days The air temperature measured locally and at up to three remote sites (ēC) (A fifth display provides a blank screen, with one roaming pixel, for use in night vision conditions). It is heavily based on GeoffG's SuperClock, TassieJim's BMP180 code and several Weather Stations on TBS. This is the schematic: The attached pdf is a sort of manual: 2017-04-05_055702_Ambi-_Mon.pdf and the set up options look like: The code is below. I'd appreciate improvements and any comments about how I could have posted the information any more effectively? Regards, Andrew_G ' ' Ambi-Mon.BAS ' ' A MMBasic program that monitors the ambient conditions of Temperature (up to four stations) and Barometric Pressure. ' It also presents the time as UTC (digital), Local(analogue) and Standard. ' It: ' - Has large extracts of code from Geoff G's Super Clock - thanks ' - Uses code from Weather Station 2 by David Eagle who thanks TassyJim for the BMP180 code - thanks too ' Many appologies to anyone I have not attributed/thanked ' The MM used is the PIC32MX170F256B-50I/SP as part of the LCD Backpack module. ' MMBasic version 5.2 is used although it should easily port to later version(s). ' Uses RTC (DS3231) and BMP180 modules as well as 3x DS18B20 for remote temperature sensing: ' DS18B20 #1 = Pin 16, #2 = Pin 21 and #3 = Pin 22. ' RTC and BMP180 I2C pin-to-CPU pin wiring= ' ------------------------ ' SCL ==> I2C Pin 17 ' SDA ==> I2C Pin 18 ' ' Load SuperClockFonts.bas into the MM's Library before loading this program ' Using the Console enter "OPTION AUTORUN ON" - an alternative is to place this command at the begining of the program (see below) ' ' Date$ and Time$ are stored as "your Local Standard" date and time on the RTC by the "RTC SetTime" command within the code ' Time and date have to be set to "your Local Standard Time" and then invoke DST = "On" to add 1hr for DST ' The UTC offset from "your Local Standard Time" can then be adjusted (it remains correct when DST is On or Off) ' Three sets of time are used: ' 1) Date$ and Time$, maintained in the RTC, are the "your local Standard Time" values as set once by the user ' (the battery backed-up RTC maintains these) ' 2) UTCsec, UTCmin, UTChour, UTCyear, UTCmth, UTCday and UTCDOW are used to calculate "Local time" by ' keeping a tally of seconds since midnight 1st Jan 2014 (by Sub GetSec) ' 3) tSec, tMin, . . . tDOW are the "Local Time" values derived from Date$ and Time$ (by using UTC calculations) after applying DST correction ' ' Known errors/improvements: (search on zzz below to find any queries/temporary fixes) ' - Check on MMBasic 5.03 ' - Check calibration of RTC working? ' 'OPTION AUTORUN ON Dim String Version = "1" 'Update to keep track of firmware vs saved MMBasic versions Const Displays = 4 ' the number of Displays is this plus 1 (ie UTC, Local, BPress, Temp and Blank) ' Set the position and size of the analogue clock dial Const ana.x = MM.HRes/2-2 Const ana.y = MM.VRes/2-1 Const ana.r = MM.VRes/2 Const c.background = RGB(black) ' background colour of the clock Const c.title = RGB(green) ' the title on each clock ' colours used in the analogue clock Const c.face = RGB(32, 32, 96) Const c.bezel = RGB(green) Const c.majormark = RGB(green) Const c.hourhand = RGB(green) Const c.minutehand = RGB(green) Const c.secondhand = RGB(red) Const c.digital = RGB(cyan) Const c.date = RGB(0, 244, 0) ' globals used by CSub DrawTriangles Dim Integer x1(3), y1(3), x2(3), y2(3), x3(3), y3(3) Dim Integer c(3) = (c.face, c.face, c.hourhand, c.minutehand) Dim Float Temp_DS(3) ' The temperature readings. Temp_DS(0) from the BMP180, (1 to 3) from 3x DS18B20 Dim Float Temp_Upper = 24.5 ' The upper limit of "Normal" temperature range - these are overridden by values "VAR Save"ed below Dim Float Temp_Lower = 23.0 ' The lower limit " Dim Float UTC_Offset, GridStep Dim Integer Col Dim Integer DisplayNbr 'The displays are UTC (digital 24 hr), Local (Analog), Baro. Press, Temperature and Blank Dim Integer thour, tmin, tsec, tdow Dim Integer UTChour, UTCmin, UTCsec, UTCdow 'Dim Integer Dim Integer tdst ' a default is set below but this is overridden by value "VAR Save"ed below Dim Integer Atmos, BPFirst = 1, BP(239), BPLast3hr(11), BPMin, BPMax Dim String Title(Displays) Length 5 = ("UTC ","Local","BPres", "Temp ", " ") Dim Integer md(12) = (0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334) Dim String mths(12) LENGTH 3 = ("---", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") Dim String abrevdays(6) LENGTH 3 = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri ", "Sat") Dim String Temp_Text(3) LENGTH 7 = ("Ambient", "BRoom1 ", "BRoom2", "Outside") ' change to suit Dim Integer UTC ' tracks UTC time in seconds since midnight 1st Jan 2014. In this version TZ is applied to this. Dim Integer TZ ' No of seconds that Local Standard Time is before (TZ = -) or after (TZ = +) UTC (Greenwich) time ' BMP180 specific Dim BMPData(2) ' setup and store data from BMP180 Dim cal(11) ' calibration data array oss = 0 ' over sampling (0 to 3) ' start of 11 BP calibration values BMP180calMEM = &HAA ' BMP180address = &H77 ' BMP180 address BMP180control = &HF4 ' BMP180 control register BMP180temp = &H2E ' BMP180 temperature command BMP180pres = &H34 ' BMP180 pressure command BMP180pres = BMP180pres + oss*&H40 ' adjust command for oversampling BMP180reading = &HF6 ' register for results of reading Dim Integer ZoomLev = 3 '0=975-1075, 1=1000-1075, 2=1000-1050, 3=1000-1025 Dim Float Zoom(3) = (2.0, 2.67, 4, 8) ' The zoom factor to be applied to each zoom level ' globals used by Sub DrawButton Dim Integer key_coord(17, 5) Dim String key_caption(17) ' colours used in the menus Const c.caption = RGB(green) Const c.button = RGB(cyan) Const c.save = RGB(white) Const c.delete = RGB(magenta) Const c.entry = RGB(yellow) Const c.special = RGB(red) Const c.ghosttext = RGB(gray) ' Start the program CLS Text MM.HRes/2, MM.VRes/2 - 20, "Ambi-Mon v"+ Version, CM, 1, 2, RGB(white) ' enable I2C. Use slower speeds for long leads I2C OPEN 400, 200 Pause 20 ' Let it catch its breath z = calibrate_bmp180() ' Extract calibration constants, "z" is not used itself but it invokes calibration Pause 1000 ' initial one second pause (required) ' test if the RTC is present I2C Write &H68, 0, 1, 0 If MM.I2C <> 0 Then I2C Write &H51, 0, 1, 2 If MM.I2C = 0 Then ' RTC present TimeSource = 1 RTC GetTime If Date$ = "01-01-2000" Then MessageBox "RTC has invalid", "date and time" RTC SetTime 16, 1, 1, 0, 0, 0 Time$ = "00:00:00" : Date$ = "01/01/16" EndIf RTCSetTime ' update the internal clock (then every 1/2 hour as below) Else CLS Text MM.HRes/2, MM.VRes/2 - 20, "RTC not found", CM, 1, 2, RGB(white) Pause 2000 'zzz Do something? EndIf ' set the initial defaults, these will be overwritten if VAR SAVE has previously been used ' set RTC to Standard time TZ = -32400 ' = -32400 for Melbourne (EST) tdst = 3600 ' = 3600 if DST time to be added, 0 if not BPZoom VAR Restore ' Restores the saved parameters (DisplayNbr, ZoomLev, Temp_Upper, Temp_Lower, tdst and TZ) 'Note that Time$ and Date$ are saved by RTC GetTime commands below ' initially set UTC and local time to Date$ and Time$ UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) GetLocalTime Temp_DS(0) = Temperature() ' Measured here to show on startup Temp_DS(1) = TEMPR(16) Temp_DS(2) = TEMPR(21) Temp_DS(3) = TEMPR(22) Atmos = Cint(pressure(oss)/100) OldTime$ = Time$ InitDisplay Print "Started at " , OldTime$, ", ",Date$ 'MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM Main program loop start it on a zero second Do ' once a second get the time, this will exit immediately if the screen is touched so that the following code can process the touch Do While OldTime$ = Time$ And Touch(x) = -1 : Loop 'Delay until a new second or a touch OldTime$ = Time$ Tmp = Touch(Y) ' check if we need to process a touch or simply update the time Select Case Touch(X) Case 0 To 120 'Touched on LH side 'previous display Do : Loop Until Touch(X) = -1 ' wait for the touch to be lifted DisplayNbr = DisplayNbr - 1 If DisplayNbr < 0 Then DisplayNbr = Displays BPFirst = 1 End If VAR Save DisplayNbr InitDisplay Case 121 To 219 'Touched in centre Do : Loop Until Touch(X) = -1 ' wait for the touch to be lifted Select Case DisplayNbr Case 0 'UTC Digital ConfigureMenu Case 1 'Analogue local ConfigureMenu Case 2 'Barometric Pressure Select Case Tmp Case 0 to 100 ' Top of screen Do : Loop Until Touch(Y) = -1 ' wait for the touch to be lifted ZoomLev = ZoomLev + 1 If ZoomLev > 3 then ZoomLev = 0 VAR Save ZoomLev BPZoom PrepareBPGraph BPGraph GoTo Skip Case 140 to 240 ' Bottom of screen Do : Loop Until Touch(Y) = -1 ' wait for the touch to be lifted ZoomLev = ZoomLev - 1 If ZoomLev <0 then ZoomLev = 3 VAR Save ZoomLev BPZoom PrepareBPGraph BPGraph GoTo Skip End Select Case 3 'Temperature - Configure "Normal" temperature range ConfigureMenu Case 4 'Blank CLS: Text 0, 22, "Local Time=", LB, 1, 2, c.title, c.background 'zzz End Select Case 220 To 319 'Touched on RH side 'next display Do : Loop Until Touch(X) = -1 ' wait for the touch to be lifted DisplayNbr = DisplayNbr + 1 BPFirst = 1 'TempFirst = 1 If DisplayNbr > Displays Then DisplayNbr = 0 End If VAR Save DisplayNbr InitDisplay Case Else ' No touch so it must be a new second so get readings and update clocks UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) GetLocalTime If Tsec = 0 And (Tmin = 0 Or Tmin = 10 Or Tmin = 20 Or Tmin = 30 Or Tmin = 40 Or Tmin = 50 Or Tmin = 5 Or Tmin = 15 Or Tmin = 25 Or Tmin = 35 Or Tmin = 45 Or Tmin = 55) Then ' Get temperature and atmospheric pressure from BM180 Temp_DS(0) = Temperature() Atmos = Cint(pressure(oss)/100) ' Store the BP data Select Case tmin Case 0 'Shuffle daily data, average second-last hour, shuffle hourly data, plot all data For i = 0 To 238 'Shuffle daily readings BP(i) = BP(i+1) Next i BP(239) = 0 Tmp = 0 For i = 0 To 3 If BPLast3hr(i) > 0 Then Tmp = Tmp + 1 BP(239) = BP(239) + BPLast3hr(i) EndIf Next i If Tmp > 0 And BP(239) > 0 Then BP(239) = BP(239)/Tmp 'average last hour For i = 0 To 7 'Shuffle hourly readings BPLast3hr(i) = BPLast3hr(i+4) Next i For i = 8 To 11 BPLast3hr(i) = 0 Next i BPLast3hr(8) = Atmos Case 15 BPLast3hr(9) = Atmos Case 30 BPLast3hr(10) = Atmos Case 45 BPLast3hr(11) = Atmos End Select Select Case DisplayNbr Case 2 ' Plot BP graph PrepareBPGraph BPGraph Case 3 ' Show the temperature TempShow Case 4 CLS:Pixel 10+5*thour,200-2*tmin, rgb(green) 'ZZZ End Select ' print current data Print Date$, ", ", OldTime$, ", ", Atmos; For i = 0 to 3: print ",", Str$(Temp_DS(i), 3, 1); Next i End If Select Case DisplayNbr Case 0 ' UTC Digital 24hr UpdateDigital UTCsec, UTCmin, UTChour Case 1 ' Local Analog UpdateAnalog Tsec, Tmin, Thour Case 2 ' BPressure If BPFirst = 1 Then PrepareBPGraph ' Clears screen, sets BPFirst to 0 and prepares grids etc. BPGraph ' Plots BP data End If BPText Case 3 ' Temperature 'Show Time at top of screen Text 0, 22, "Local Time=", LB, 1, 2, c.title, c.background Text 185, 22, Str$(Thour, 2, 0, "0") + " " + Str$(Tmin, 2,0, "0") , LB, 1, 2, c.title, c.background Circle 224, 3, 2, , ,c.title, c.title ' Top of : Circle 224, 13, 2, , ,c.title, c.title ' Bottom of : Case 4 'Blank CLS:Pixel 10+5*thour,200-2*tmin, rgb(green) 'ZZZ End Select If (Tmin = 5 Or Tmin = 35) And Tsec = 35 Then ' Reset the time at hh:05:35 and hh:35:35 Print "Old time (EST)= ", Time$; RTCSetTime Print ", New time (EST)= ", Time$, Do While Val(Mid$(Time$, 7,2)) < 35: Loop OldTime$ = Time$ Print ". Paused until ", OldTime$, " (EST)." End If End Select Skip: Loop 'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm End ''''''''''''''''''''''''' ' subs to get and show temperatures Sub TempShow cls 'Show Time at top of screen Text 0, 22, "Local Time=", LB, 1, 2, c.title, c.background Text 185, 22, Str$(Thour, 2, 0, "0") + " " + Str$(Tmin, 2,0, "0") , LB, 1, 2, c.title Circle 224, 3, 2, , ,c.title, c.title ' Top of : Circle 224, 13, 2, , ,c.title, c.title ' Bottom of : Temp_DS(0) = Temperature() ' From the BMP180 Temp_DS(1) = TEMPR(16) ' From the DS18B20s Temp_DS(2) = TEMPR(21) Temp_DS(3) = TEMPR(22) For I = 0 to 3 Col = RGB(Green) If Temp_DS(I) > Temp_Upper then Col = RGB(Red) If Temp_DS(I) < Temp_Lower then Col = RGB(Cyan) Text 0, 65+i*54, Temp_Text(i), LB, 1,2, RGB(White) If Temp_DS(i) > 0 and Temp_DS(i) <> 1000 then Text 120,90+i*54,Str$(Temp_DS(I),2,1),LB,2,2,Col 'RGB(Cyan) Next i End Sub 'TempShow ''''''''''''''''''''''''' ' sub routines to plot the BP graph Sub BPZoom Select Case ZoomLev Case 0 BPMin = 975 BPMax = 1075 GridStep = 25 Case 1 BPMin = 1000 BPMax = 1075 GridStep = 25 Case 2 BPMin = 1000 BPMax = 1050 GridStep = 10 Case 3 BPMin = 1000 BPMax = 1025 GridStep = 5 End Select End Sub Sub PrepareBPGraph CLS BPFirst = 0 For i = BPMin + GridStep To BPMax Step GridStep 'Grey grid lines Line 15, MM.VRes-16-Zoom(ZoomLev)*(i-BPMin),MM.HRes, MM.VRes-16-Zoom(ZoomLev)*(i-BPMin), ,RGB(Gray) Line 12, MM.VRes-16-Zoom(ZoomLev)*(i-BPMin),15, MM.VRes-16-Zoom(ZoomLev)*(i-BPMin), ,RGB(White) 'Grid y ticks Next i 'Y axis Line 15, MM.VRes - 15, 15, MM.VRes-216, , RGB(White) Text 0, MM.VRes/2-25, "h", LB, 1,1, RGB(White) Text 0, MM.VRes/2 - 14, "P", LB, 1,1, RGB(White) Text 0, MM.VRes/2 - 3, "a", LB, 1,1, RGB(White) Text 0, MM.VRes - 16, Str$(BPMin), LB, 1,1,RGB(White) Line 12, MM.VRes-16,15, MM.VRes-16, ,RGB(White) 'Bottom y tick Text 0, MM.VRes-216, Str$(BPMax), LB, 1,1,RGB(White) Line 15+ 242, MM.VRes - 16, 15+242, MM.VRes-216, ,RGB(White)'2nd y axis 'X axis Line 15, MM.VRes - 15, MM.HRes, MM.VRes -15, , RGB(White) Text 3, MM.VRes, "-10 9 8 7 6 Day 4 3 2 1 0", LB, 1,1, RGB(White) Text 270, MM.VRes, "2 1-hr", LB, 1,1, RGB(White) For i = 1 To 10 ' Main X ticks Line 15 + 24*i, MM.VRes -12, 15 + 24*i, MM.VRes -15, , RGB(White) Next i For i = 1 To 3 ' Last 3 hour ticks Line 258 + 16*i, MM.VRes -12, 258 + 16*i, MM.VRes -15, , RGB(White) Next i End Sub 'PrepareBPGraph Sub BPGraph 'Draw BP Graph For i = 0 To 239 'last 10 days If BP(i) <> 0 Then If BP(i) => BPMin And BP(i) <= BPMax Then Line i+16, MM.VRes-16, i+16, MM.VRes-16-Zoom(ZoomLev)*(BP(i)-BPMin), ,RGB(Green) Else Line i+16, MM.VRes-16, i+16, MM.VRes-16-Zoom(ZoomLev)*(BP(i)-BPMin), ,RGB(Yellow) End If End If Next i For i= 0 To 11 'last 3 hours If BPLast3hr(i) <> 0 Then If BPLast3hr(i) => BPMin And BPLast3hr(i) <= BPMax Then Line 15+244+ i*4, MM.VRes-16, 15+244+i*4, MM.VRes-16-Zoom(ZoomLev)*(BPLast3hr(i)-BPMin),3 ,RGB(Cyan) Else Line 15+244+ i*4, MM.VRes-16, 15+244+i*4, MM.VRes-16-Zoom(ZoomLev)*(BPLast3hr(i)-BPMin),3 ,RGB(Yellow) End If End If Next i BPText End Sub 'Draw BP Graph Sub BPText ' Show the Time, Temp and BP readings over the graph Text 0, -2, "BP Graph", LT, 1, 1, c.title, c.background Text 80, 22, Str$(Thour, 2, 0, "0") + " " + Str$(Tmin, 2,0, "0")+ " " + mid$(Str$(Temp_DS(0), 2),1,2)+ " " + Mid$(Str$(Temp_DS(0),2,1,"0"),4,1) + " " + Str$(Atmos, 4), LB, 1, 2, RGB(Cyan) ' Use circles rather than "+"s Circle 119, 3, 2, , ,RGB(Cyan),RGB(Cyan) ' Top of : Circle 119, 13, 2, , ,RGB(Cyan),RGB(Cyan) ' Bottom of : Circle 214, 15, 2, , ,RGB(Cyan),RGB(Cyan) ' . Circle 244, 4, 4, , ,c.digital ' Degrees End Sub 'BPText ' initial setup of the clock (either analogue or digital) Sub InitDisplay Local Float i, y, xx, yy, r1, r2, tim UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) ' UTC = UTC + TZ GetLocalTime Select Case DisplayNbr Case 0 ' UTC Digital 24 CLS c.background Text 0, -3, Title(DisplayNbr), LT, 1, 2, c.title, c.background UpdateDigital -1, UTCmin, UTChour Case 1 ' Analogue CLS c.background Text 0, -3, Title(DisplayNbr), LT, 1, 2, c.title, c.background Circle ana.x, ana.y, ana.r, 5, 1, c.bezel, c.face For i = 0 To 59 If i Mod 15 = 0 Then For y = -2 To +2 tim = (i + y/10) : xx = Cos(Rad(tim * 6)) : yy = Sin(Rad(tim * 6)) r1 = ana.r - 20 : r2 = ana.r - 5 Line ana.x + xx*r1, ana.y - yy*r1, ana.x + xx*r2, ana.y - yy*r2, 1, c.majormark Next y ElseIf i Mod 5 = 0 Then For y = -2 To +2 tim = (i + y/10) : xx = Cos(Rad(tim * 6)) : yy = Sin(Rad(tim * 6)) r1 = ana.r - 15 : r2 = ana.r - 5 Line ana.x + xx*r1, ana.y - yy*r1, ana.x + xx*r2, ana.y - yy*r2, 1, c.majormark Next y Else tim = i : xx = Cos(Rad(tim * 6)) : yy = Sin(Rad(tim * 6)) r1 = ana.r - 10 : r2 = ana.r - 5 Line ana.x + xx*r1, ana.y - yy*r1, ana.x + xx*r2, ana.y - yy*r2, 1, c.majormark EndIf Next i UpdateAnalog -1, tmin, thour UpdateAnalog -1, tmin, thour 'The repeat is required! Case 2 ' B Pressure PrepareBPGraph 'Draw the graph - no data BPGraph 'Plot the data Case 3 ' Temperature TempShow Case 4 ' Blank CLS:Pixel 10+5*thour,200-2*tmin, rgb(green) 'ZZZ End Select End Sub 'InitDisplay Sub UpdateDigital s As Float, m As Float, h As Float Local Float sec = s, min = m, hr = h, offset offset = 6 If sec <= 0 Then Text -8 + offset, 50, Str$(hr, 2, 0, "0"), , 3, 1, c.digital ' h=hr Text 141 + offset, 50, Str$(min, 2, 0, "0"),, 3, 1, c.digital ' m=min Circle 130 + offset, 80, 6, 0, 1, 0, c.digital ' top of : Circle 130 + offset, 122, 6, 0, 1, 0, c.digital ' bottom of : Text MM.HRes/2, MM.VRes - 40, " " + abrevdays(UTCdow) + " ", CB, 2, 1, c.date Text MM.HRes/2, MM.VRes - 5, " " + Str$(UTCday) + " " + mths(UTCmth) + " " + Str$(UTCyear + 2000) + " ", CB, 2, 1, c.date EndIf If sec >= 0 Then Text MM.HRes + 5, 152, Str$(sec, 2, 0, "0"), RB, 2, 1, RGB(Cyan) End Sub 'UpdateDigital Sub UpdateAnalog s As Float, m As Float, h As Float Local Float minutes = m - 15, hour = (h - 3) + m/60, sec = s - 15 ' Digital time and temperature Text MM.HRes/2, MM.VRes/2 + 70, Str$(thour, 2,0, "0") + ":" + Str$(tmin, 2,0, "0") , CB, 2, 1, c.digital, c.face Text MM.HRes/2, MM.VRes/2 + 105, Str$(Temp_DS(0), 2, 1), CB, 2, 1, c.digital, c.face Circle MM.HRes/2 + 50, MM.VRes/2 + 75, 4, , ,c.digital 'deg symbol If hour >= 12 Then hour = hour - 12 Line ana.x, ana.y, GetX(PrevSec, ana.r - 21), GetY(PrevSec, ana.r - 21), 1, c.face PrevSec = sec If s > 0 Then Circle ana.x, ana.y, ana.r * 0.075, 1, 1, c.hourhand, c.hourhand If x1(0) <> 0 Then DrawTriangles 2, x1(2), y1(2), x2(2), y2(2), x3(2), y3(2), c(2) Else x1(0) = x1(2) : x1(1) = x1(3) : y1(0) = y1(2) : y1(1) = y1(3) x2(0) = x2(2) : x2(1) = x2(3) : y2(0) = y2(2) : y2(1) = y2(3) x3(0) = x3(2) : x3(1) = x3(3) : y3(0) = y3(2) : y3(1) = y3(3) x1(2) = GetX((hour * 5) - 15, ana.r * 0.075) y1(2) = GetY((hour * 5) - 15, ana.r * 0.075) x2(2) = GetX((hour * 5) + 15, ana.r * 0.075) y2(2) = GetY((hour * 5) + 15, ana.r * 0.075) x3(2) = GetX(hour * 5, ana.r * 0.55) y3(2) = GetY(hour * 5, ana.r * 0.55) x1(3) = GetX(minutes - 15, ana.r * 0.05) y1(3) = GetY(minutes - 15, ana.r * 0.05) x2(3) = GetX(minutes + 15, ana.r * 0.05) y2(3) = GetY(minutes + 15, ana.r * 0.05) x3(3) = GetX(minutes, ana.r - 21) y3(3) = GetY(minutes, ana.r - 21) Circle ana.x, ana.y, ana.r * 0.075, 1, 1, c.hourhand, c.hourhand If x1(0) <> 0 Then DrawTriangles 4, x1(), y1(), x2(), y2(), x3(), y3(), c() Text 47, MM.VRes, abrevdays(tdow), CB, 1, 2, c.date Text MM.HRes - 50, MM.VRes, Str$(tday), RB, 1, 2, c.date Text MM.HRes, MM.VRes, Left$(mths(tmth), 3), RB, 1, 2, c.date EndIf If s >= 0 Then Line ana.x, ana.y, GetX(sec, ana.r - 21), GetY(sec, ana.r - 21), 1, c.secondhand Circle ana.x, ana.y, ana.r * 0.05, 1, 1, c.minutehand, c.minutehand End Sub 'UpdateAnalog ' utility to get the x coord of a vector on the analogue clock Function GetX(tim As Float, r As Float) As Integer 'Float Local Float t = tim If t > 359 Then t = t - 360 If t < 0 Then t = t + 360 GetX = ana.x + Cos(Rad(t * 6)) * r End Function 'GetX ' utility to get the y coord of a vector on the analogue clock Function GetY(tim As Float, r As Float) As Integer 'Float Local Float t = tim If t > 359 Then t = t - 360 If t < 0 Then t = t + 360 GetY = ana.y + Sin(Rad(t * 6)) * r End Function 'GetY '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' the main configuration menu Sub ConfigureMenu Local Float i, btn Redisplay: WatchDog 1200000 CLS Font 1, 2 Select Case DisplayNbr 'DisplayNbr No.1 Case 0 ' UTC digital 24 Text 0, 0, Title(DisplayNbr), LT, 2, 1, c.title, c.background Text 0, 30, "Use Local to set:",L ,1 ,2 , c.entry Text 20, 55, "Standard Date/Time",L ,1 ,2 , c.entry Text 20, 80, "and DST Off/On.",L ,1 ,2 , c.entry Text 0, 105, "Then here to set UTC",L ,1 ,2 , c.entry Text 0, 130, "Offset.",L ,1 ,2 , c.entry DrawButton 0, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 1, 0, MM.HRES/2-125, 170, 250, 30, c.button, "Set UTC Offset" Do btn = CheckButtonPress(0, 1) Select Case btn Case 0 ' Cancel Pause 200 CheckButtonRelease 0 InitDisplay Exit Sub Case 1 ' Set UTC Offset Pause 200 CheckButtonRelease 1 UTC_Offset = TZ / 3600 SetUTCOffset: cls Text 0, 0, "Set UTC O'set", LT, 2, 1, c.title, c.background Text 0, 50, "O'set:" ,L ,1 ,2 , c.entry Text 90, 50, Str$(UTC_Offset) ,L ,2 ,1 , c.button ShowAllTimes ' n Dn x y w h DrawButton 1, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 2, 0, 215, 40, 50, 45, c.button, "-" ' - DrawButton 3, 0, 270, 40, 50, 45, c.button, "+" ' + DrawButton 4, 0, 200, 211, 120, 30, c.save, "Save" Do btn = CheckButtonPress(1, 4) Select Case btn Case 1 ' Cancel Pause 200 CheckButtonRelease 1 UTC_Offset = 0 CLS: GoTo ReDisplay case 2 ' - Pause 200 CheckButtonRelease 2 If UTC_Offset > -24 then UTC_Offset = UTC_Offset - 0.5 Else MessageBox "Only -24 to 24" GoTo SetUTCOffset Endif Text 95, 50, Space$(5) ,L ,2 ,1 , c.background Text 95, 50, Str$(UTC_Offset) ,L ,2 ,1 , c.button ShowAllTimes Case 3 ' + Pause 200 CheckButtonRelease 3 If UTC_Offset < 24 then UTC_Offset = UTC_Offset + 0.5 Else MessageBox "Only -24 to 24" GoTo SetUTCOffset Endif Text 95, 50, Space$(5) ,L ,2 ,1 , c.background Text 95, 50, Str$(UTC_Offset) ,L ,2 ,1 , c.button ShowAllTimes Case 4 ' Save Pause 200 CheckButtonRelease 4 TZ = UTC_Offset * 3600 VAR SAVE TZ UTC_Offset = 0 GoTo ReDisplay End Select Loop End Select Loop Case 1 ' Local analog Text 0, 0, Title(DisplayNbr), LT, 2, 1, c.title, c.background Text 0, 30, "Here to set Standard",L ,1 ,2 , c.entry Text 0, 55, "date & time and",L ,1 ,2 , c.entry Text 0, 80, "DST Off/On.",L ,1 ,2 , c.entry Text 0, 105, " (Use UTC to set",L ,1 ,2 , c.entry Text 5, 130, " UTC offset.)",L ,1 ,2 , c.entry ' n Dn x y w h DrawButton 1, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 2, 0, 180, 211, 140, 30, c.button, "Continue" Do btn = CheckButtonPress(1, 2) Select Case btn Case 1 'Cancel Pause 200 CheckButtonRelease 1 InitDisplay Exit Sub Case 2 ' Continue ' Here to set Standard date and time and DST Off/On CLS UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) GetLocalTime Text 0, 0, "Standard:", LT, 2, 1, c.title, c.background Text 10, 30, Mid$(Date$, 1, 2) + "/" + Mid$(Date$, 4, 2) + "/" + Mid$(Date$, 9, 2),L ,1 ,2 , c.entry Text 200, 30, Mid$(Time$, 1, 5),L,1,2,c.entry Text 0, 110, "Local:", LT, 2, 1, c.title, c.background Text 10, 140, Str$(tday, 2, 0, "0") + "/" + str$(tmth, 2, 0, "0") + "/" + str$(tyear, 2, 0, "0"),L ,1 ,2 , c.entry Text 200, 140, Str$(thour, 2, 0, "0") + ":" + str$(tmin, 2, 0, "0"),L ,1 ,2 , c.entry DrawButton 1, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 2, 0, 0, 60, 150, 30, c.button, "Std Date" DrawButton 3, 0,170, 60, 150, 30, c.button,"Std Time" DrawButton 4, 0,20, 170, 280, 30, c.button,"DST Off/On" Do btn = CheckButtonPress(1, 4) If btn >= 0 Then Timer = 0 Pause 200 If btn = 3 Then ' Hold the "Std time" button to enable TrimAging Do While TimeSource = 1 And Touch(x) <> -1 And Timer < 3000 : Loop If Timer >= 3000 Then TrimAging GoTo redisplay EndIf EndIf CheckButtonRelease btn EndIf Select Case btn Case 1 'Cancel Pause 200 CheckButtonRelease 1 CLS: GoTo ReDisplay Case 2 ' Here to set Standard date Pause 200 CheckButtonRelease 2 GetDateTime 1 ' 1 means it is a date CLS: GoTo ReDisplay Case 3 ' Here to set Standard time Pause 200 CheckButtonRelease 3 GetDateTime 0 ' 0 means it is a time CLS: GoTo ReDisplay Case 4 ' Here to set DST Off/On Oldtdst = tdst 'tdst = 3600 if DST On to be added, 0 if Off CLS: Text 0, 0, "DST Off/On", LT, 2, 1, c.title, c.background ' n Dn x y w h DrawButton 1, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 2, 0, 140, 140, 80, 45, c.button, "Off" DrawButton 3, 0, 230, 140, 80, 45, c.button, "On" DrawButton 4, 0, 200, 211, 120, 30, c.save, "Save" ShowStandandLocalTime Do btn = CheckButtonPress(1, 4) Select Case btn Case 1 'Cancel Pause 200 CheckButtonRelease 1 tdst = Oldtdst Getlocaltime CLS: GoTo ReDisplay Case 2 'Off Pause 200 CheckButtonRelease 2 tdst = 0 ShowStandandLocalTime Case 3 'On Pause 200 CheckButtonRelease 3 tdst = 3600 ShowStandandLocalTime Case 4 'Save Pause 200 CheckButtonRelease 4 VAR Save tdst UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) 'UTC = UTC + TZ Getlocaltime CLS: GoTo ReDisplay End Select Loop End Select Loop End Select Loop Case 2 ' BP Case 3 ' Temperature Text 0, 0, "Temperature", LT, 2, 1, c.title, c.background Text 0, 30, "Set " + CHR$(34) + "Normal" + CHR$(34) + " range:",L ,1 ,2 , c.entry ' n Dn x y w h DrawButton 1, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 2, 0, 200, 65, 50, 45, c.button, "-" ' -U DrawButton 3, 0, 255, 65, 50, 45, c.button, "+" ' +U DrawButton 4, 0, 200, 115, 50, 45, c.button, "-" ' -L DrawButton 5, 0, 255, 115, 50, 45, c.button, "+" ' +L DrawButton 6, 0, 200, 211, 120, 30, c.save, "Save" Temp_U = Temp_Upper Temp_L = Temp_Lower Text 0, 100, "Upper",LB, 1,2, c.entry Text 0, 150, "Lower",LB, 1,2, c.entry ChangeRange: Text 110, 100, Str$(Temp_U, 2, 1), LB, 1, 2, c.button Text 110, 150, Str$(Temp_L, 2, 1), LB, 1, 2, c.button Do btn = CheckButtonPress(1, 6) Select Case btn Case 1 ' Cancel TempShow Exit Sub case 2 ' -U Pause 200 CheckButtonRelease 2 Temp_U = Temp_U - 0.5 If Temp_U < Temp_L then Temp_U = Temp_L Text 0, 190, "Upper to be >= Lower", LB, 1, 2, c.special Pause 1500 Text 0, 190, Space$(20), LB, 1, 2, c.background End If Goto ChangeRange Case 3 ' +U Temp_U = Temp_U + 0.5 Pause 200 CheckButtonRelease 3 GoTo ChangeRange Case 4 ' -L Pause 200 CheckButtonRelease 4 Temp_L = Temp_L - 0.5 GoTo ChangeRange Case 5 ' +L Temp_L = Temp_L + 0.5 Pause 200 CheckButtonRelease 5 If Temp_U < Temp_L then Temp_L = Temp_U Text 0, 190, "Upper to be >= Lower", LB, 1, 2, c.special Pause 1500 Text 0, 190, Space$(20), LB, 1, 2, c.background End If GoTo ChangeRange Case 6 ' Save CheckButtonRelease 6 Temp_Upper = Temp_U Temp_Lower = Temp_L VAR SAVE Temp_Upper, Temp_Lower TempShow Exit Sub End Select Loop End Select End Sub 'ConfigureMenu Sub ShowStandandLocalTime UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) Getlocaltime Text 0, 65, "Stand" ,L ,1 ,2 , c.entry Text 90, 65, Mid$(Date$, 1,2) + "/" + Mid$(Date$, 4,2) + "/" + Mid$(Date$, 9,2),L ,1 ,2 , c.ghosttext Text 230, 65, Mid$(Time$, 1,2) + ":" + Mid$(Time$, 4,2),L ,1 ,2 , c.ghosttext Text 0, 100, "Local",L, 1,2, c.entry Text 90, 100, Str$(tday, 2, 0, "0") + "/" + str$(tmth, 2, 0, "0") + "/" + str$(tyear, 2, 0, "0"),L ,1 ,2 , c.ghosttext Text 230, 100, Str$(thour, 2, 0, "0") + ":" + str$(tmin, 2, 0, "0"),L ,1 ,2 , c.ghosttext Text 0, 150, "Set DST:",L, 1,2, c.entry 'Highlight which applies now If tdst then rbox 139,139,82,47,,c.background rbox 138,138,84,49,,c.background rbox 229,139,82,47,,RGB(Green) rbox 228,138,84,49,,RGB(Green) Else rbox 139,139,82,47,,RGB(Green) rbox 138,138,84,49,,RGB(Green) rbox 229,139,82,47,,c.Background rbox 228,138,84,49,,c.Background Endif End Sub Sub ShowAllTimes UTC = GetSec(Val(Right$(Date$, 2)), Val(Mid$(Date$, 4, 2)), Val(Left$(Date$, 2)), Val(Left$(Time$, 2)), Val(Mid$(Time$, 4, 2)), Val(Right$(Time$, 2))) Getlocaltime Text 0, 100, "UTC" ,L ,1 ,2 , c.entry Text 90, 100, Str$(UTCday, 2, 0, "0") + "/" + str$(UTCmth, 2, 0, "0") + "/" + str$(UTCyear, 2, 0, "0"),L ,1 ,2 , c.ghosttext Text 230, 100, Str$(UTChour, 2, 0, "0") + ":" + str$(UTCmin, 2, 0, "0"),L ,1 ,2 , c.ghosttext Text 0, 130, "Std" ,L ,1 ,2 , c.entry Text 90, 130, Mid$(Date$, 1,2) + "/" + Mid$(Date$, 4,2) + "/" + Mid$(Date$, 9,2),L ,1 ,2 , c.ghosttext Text 230, 130, Mid$(Time$, 1,2) + ":" + Mid$(Time$, 4,2),L ,1 ,2 , c.ghosttext Text 0, 160, "Local",L, 1,2, c.entry Text 90, 160,Str$(tday, 2, 0, "0") + "/" + str$(tmth, 2, 0, "0") + "/" + str$(tyear, 2, 0, "0"),L ,1 ,2 , c.ghosttext Text 230, 160, Str$(thour, 2, 0, "0") + ":" + str$(tmin, 2, 0, "0"),L ,1 ,2 , c.ghosttext End Sub ' menu to get and set the aging trim for the DS3231 Sub TrimAging Local Integer r ,b Local Float n CLS Font 2, 1 Text MM.HRes/2, 10, "DS3231", CT, 2 ,1, c.caption Text MM.HRes/2, 45, "Aging Offset", CT, 2, 1, c.caption RTC GetReg &H10, r If MM.I2C > 0 Then MessageBox "Error reading", "from RTC" Exit Sub EndIf If r > 127 Then n = r - 256 Else n = r EndIf Text 50, 100, Str$(n, -4, 0),L , 2, 1, c.entry DrawButton 0, 0, 200, 95, 50, 42, c.button, "-" DrawButton 1, 0, 260, 95, 50, 42, c.button, "+" Text MM.HRes/2, 142, "Positive values will slow the clock,", CT, 1, 1, c.entry Text MM.HRes/2, 157, "Negative values will speed it up", CT, 1, 1, c.entry Font 1, 2 DrawButton 2, 0, 0, 211, 120, 30, c.special, "Cancel" DrawButton 3, 0, 200, 211, 120, 30, c.save, "Save" Do While Touch(x) <> -1 : Loop Do b = CheckButtonPress(0, 14) Select Case b Case 0 ' - pressed n = n - 1 If n < -127 Then n = -127 Text 50, 100, Str$(n, -4, 0, " "),L , 2, 1, c.entry CheckButtonRelease 0 Case 1 ' + pressed n = n + 1 If n > 127 Then n = 127 Text 50, 100, Str$(n, -4, 0, " "),L , 2, 1, c.entry CheckButtonRelease 1 Case 2 Exit Do Case 3 r = n And &B11111111 RTC SetReg &H10, r If MM.I2C > 0 Then MessageBox "Error writing", "to RTC" EndIf Exit Do End Select Loop End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' subroutines involved with manipulating time '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' find the local time (incl DST) from the UTC variable which is counting UTC time ' updates the global variables tyear, tmth, tday, tdow, thour, tmin, tsec, tdst Sub GetLocalTime Local Integer t t = UTC If UTC_Offset = 0 Then UTC = UTC + TZ Else UTC = UTC + UTC_Offset*3600 Endif UTCsec = UTC Mod 60 UTCmin = (UTC \ 60) Mod 60 UTChour = (UTC \ 3600) Mod 24 UTCyear = GetYear(UTC) UTCmth = GetMonth(UTC) UTCday = GetDay(UTC) UTCdow = GetDOW(UTC) t = t + tdst tsec = t Mod 60 tmin = (t \ 60) Mod 60 thour = (t \ 3600) Mod 24 tyear = GetYear(t) tmth = GetMonth(t) tday = GetDay(t) tdow = GetDOW(t) End Sub 'GetLocalTime ' menu to get a date or time ' this can handle either date (dt = 1) or time (dt = 0) Sub GetDateTime dt As Integer Local Integer digit, i, b, d, m, y Local String SCap(9) LENGTH 8 = ("7","8","9","4","5","6","1","2","3","0") Local String str, strold Const bh = MM.VRes\5, bw = MM.HRes\5 If dt Then strold = "dd/mm/yy" Else strold = "hh:mm:ss" str = strold digit = 1 Font 1, 2 CLS For i = 0 To 8 DrawButton i, 0, bw + bw * (i Mod 3) + 2, bh + bh * (i \ 3) + 2, bw - 4, bh - 4, c.button, SCap(i) Next i DrawButton 9, 0, bw*2 + 2, bh*4 + 2, bw - 4, bh - 4, c.button, "0" DrawButton 10, 0, 260, 48, 60, 140, c.delete, "Del" DrawButton 11, 0, bw*3 + 2, bh*4 + 2, bw * 2 - 4, bh - 4, c.save, "SAVE" DrawButton 12, 0, 0, bh*4 + 2, bw * 2 - 4, bh - 4, c.special, "Cancel" DisplayDateTimeStr str Do If Timer > 700 Then Line 40 + digit * 24, 43, 64 + digit * 24, 43, 2, c.entry: Timer = 0 b = CheckButtonPress(0, 12) If Timer > 500 Or b > 0 Then Line 40 + digit * 24, 43, 64 + digit * 24, 43, 2, 0 Select Case b Case 0 To 9 If digit < 9 Then str = Left$(str, digit-1) + SCap(b) + Mid$(str, digit+1, 9) digit = digit + 1 If digit = 3 Or digit = 6 Then digit = digit + 1 DisplayDateTimeStr str EndIf Pause 200 CheckButtonRelease b Case 10 'Del If digit > 1 Then digit = digit - 1 If digit = 3 Or digit = 6 Then digit = digit - 1 str = Left$(str, digit-1) + Mid$(strold, digit) DisplayDateTimeStr str EndIf Pause 200 CheckButtonRelease b Case 11 'Save Pause 200 CheckButtonRelease b d = Val(Left$(str, 2)) m = Val(Mid$(str, 4, 2)) y = Val(Right$(str, 2)) If dt Then ' Is a date If y < 17 Or m < 1 Or m > 12 Or d < 1 Or d > 31 Then MessageBox "Invalid", "Date" Else UTC = GetSec(y, m, d, thour, tmin, tsec) EndIf Else ' Is a time If Mid$(str, 5, 1) = "m" Or y > 59 Or m > 59 Or d > 23 Then MessageBox "Invalid", "Time" Else UTC = GetSec(tyear, tmth, tday, d, m, y) EndIf EndIf If TimeSource = 1 Then RTC SetTime GetYear(UTC), GetMonth(UTC), GetDay(UTC), (UTC \ 3600) Mod 24, (UTC \ 60) Mod 60, UTC Mod 60 EndIf Date$ = Str$(GetDay(UTC)) + "/" + Str$(GetMonth(UTC)) + "/" + Str$(GetYear(UTC)) Time$ = Str$((UTC \ 3600) Mod 24) + ":" + Str$((UTC \ 60) Mod 60) + ":" + Str$(UTC Mod 60) Exit Do Case 12 ' Cancel pressed Pause 200 CheckButtonRelease b Exit Do End Select EndIf Loop End Sub ' utility sub to display formatted date or time Sub DisplayDateTimeStr s As String Local Float i For i = 1 To 8 If i = 3 Or i = 6 Then Text 40 + 24 * i, 10, Mid$(s, i, 1), , 2, 1, RGB(white), 0 ElseIf Mid$(s, i, 1) > "9" Then Text 40 + 24 * i, 10, Mid$(s, i, 1), , 2, 1, c.ghosttext, 0 Else Text 40 + 24 * i, 10, Mid$(s, i, 1), , 2, 1, c.entry, 0 EndIf Next i End Sub ' calculate the seconds since midnight 1st Jan 2014 Function GetSec(yr As Integer, mth As Integer, day As Integer, hr As Integer, min As Integer, sec As Integer) As Integer GetSec = (yr - 14) * (365 * 24 * 60) GetSec = GetSec + ((yr - 13) \ 4) * (24 * 60) GetSec = GetSec + (md(mth) * (24 * 60)) GetSec = GetSec + ((day - 1) * (24 * 60)) GetSec = GetSec + (hr * 60) GetSec = ((GetSec + min) * 60) + sec If (yr - 16) Mod 4 = 0 And mth > 2 Then GetSec = GetSec + (24 * 3600) End Function ' convert seconds to the year (two digits) Function GetYear(seconds As Integer) As Float Local Float yr For yr = 14 To 99 If seconds < GetSec(yr + 1, 1, 1, 0, 0, 0) Then Exit For Next yr GetYear = yr End Function ' convert seconds to the month (Jan = 1) Function GetMonth(seconds As Integer) As Float Local Float mth For mth = 1 To 12 If seconds < GetSec(tyear, mth, 1, 0, 0, 0) Then Exit For Next mth GetMonth = mth - 1 End Function ' convert seconds to the day of the month Function GetDay(seconds As Integer) As Float GetDay = ((seconds - GetSec(tyear, tmth, 1, 0, 0)) \ (24 * 3600)) + 1 End Function ' convert seconds to the day of the week (Sunday = 0) Function GetDOW(seconds As Integer) As Float GetDOW = ((seconds \ (24 * 3600)) + 3) Mod 7 End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' misc utility subroutines '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub RTCSetTime ' called every 1/2hour (at hh:05:35 and hh:35:35) RTC GetTime End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Draw buttons and get button presses ' ' The subrouting DrawButton will draw a button (normally used when drawing ' the screen for input). ' ' The function CheckButtonPress() will check if a button has been touched. ' If it has it will set it to selected (reverse video) and return with the ' button's number. ' ' The subroutine CheckButtonRelease will wait for the touch to be released ' and will then draw the button as normal. ' ' These routines use the global arrays key_coord() and key_caption() to ' track the coordinates and size of each button and save its caption. ' ' IMPORTANT: These routines set the watchdog to 20 minutes. If a button ' has not been pressed within this time the Micromite will ' restart. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' draw a button Sub DrawButton n As Integer, mode As Integer, x As Integer, y As Integer, w As Integer, h As Integer, c As Integer, s As String Local Integer bc, fc If mode = 0 Then key_coord(n,0) = x : key_coord(n,1) = y : key_coord(n,2) = w : key_coord(n,3) = h key_coord(n,4) = c : key_caption(n) = s EndIf If mode > 1 Then bc = key_coord(n,4) : fc = 0 ' draw in reverse video if it is being touched Else bc = 0 : fc = key_coord(n,4) ' a normal (untouched) button EndIf RBox key_coord(n,0), key_coord(n,1), key_coord(n,2), key_coord(n,3), , key_coord(n,4), bc) Text key_coord(n,0) + key_coord(n,2)/2, key_coord(n,1) + key_coord(n,3)/2, key_caption(n), CM, , , fc, bc End Sub ' check if a button has been touched and animate the button's image ' returns the button's number Function CheckButtonPress(startn As Integer, endn As Integer) As Integer Local Integer xt, yellowt, n CheckButtonPress = -1 If Touch(x) <> -1 Then ' we have a touch WatchDog 1200000 xt = Touch(x) yellowt = Touch(y) ' scan the array key_coord() to see if the touch was within the ' boundaries of a button For n = startn To endn If xt > key_coord(n,0) And xt < key_coord(n,0) + key_coord(n,2) And yellowt > key_coord(n,1) And yellowt < key_coord(n,1) + key_coord(n,3) Then ' we have a button press ' draw the button as pressed DrawButton n, 2 CheckButtonPress = n Exit For EndIf Next n EndIf End Function ' wait for the touch to be released and then draw the button as normal Sub CheckButtonRelease n As Integer ' if a button is currently down check if it has been released Do While Touch(x) <> -1 : Loop ' wait for the button to be released DrawButton n, 1 ' draw the button as normal (ie, not pressed) End Sub ' this handy routine draws a message box with an OK button ' then waits for the button to be touched ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub MessageBox s1 As String, s2 As String Local Integer w If Len(s1) > Len(s2) Then w = Len(s1) Else w = Len(s2) w = w * 8 ' get the width of the text (used for the box width) ' draw the box and the message in it RBox MM.HRes/2 - w - 20, 60, w * 2 + 40, 130, , c.entry, 0 Text MM.HRes/2, 70, s1, CT, 1, 2, RGB(white) Text MM.HRes/2, 100, s2, CT, 1, 2, RGB(white) ' draw the OK button RBox 110, 140, 100, 34, , c.button Text MM.HRes/2, 157, "OK", CM, 1, 2, c.button ' wait for the button to be touched WatchDog 1200000 Do While Not (Touch(x) > 110 And Touch(x) < 210 And Touch(y) > 140 And Touch(y) < 180) : Loop ' draw the OK button as depressed RBox 110, 140, 100, 34, , c.button, c.button Text MM.HRes/2, 157, "OK", CM, 1, 2, 0, c.button ' wait for the touch to be removed Do While Touch(x) <> -1 : Loop End Sub 'MessageBox Function calibrate_bmp180() ' extract bmp180 calibration constants Local n, calMEM calMEM= BMP180calMEM For n = 1 To 11 ' first calibration location I2C WRITE BMP180address, 0, 1, calMEM Pause 1 I2C READ BMP180address, 0, 2, BMPData(0) cal(n) = BMPData(0)*256 + BMPData(1) If n < 4 Or n > 6 Then ' need to convert some to signed numbers If (cal(n) > 32767) Then cal(n) = cal(n) - 65536 EndIf EndIf Pause 1 ' advance to the next calibration location calMEM = calMEM + 2 Next n End Function Function temperature() ' returns the temperature in degrees C to one decimal place Local UT, x1, x2, b5 I2C WRITE BMP180address, 0, 2, BMP180control, BMP180temp Pause 5 I2C WRITE BMP180address, 0, 1, BMP180reading I2C READ BMP180address, 0, 2, BMPData(0) UT = BMPData(0)*256 + BMPData(1) 'calculate true temperature x1= Int( (UT-cal(6))*cal(5)/32768) x2=Int( cal(10)*2048/(x1+cal(11))) b5=x1+x2 temperature = Int((b5+8)/16)/10 End Function 'temperature() Function pressure(oss) ' atmospheric pressure in inches of mercury Local UT, UP, x1, x2, x3, b5, b6, b7, pres, p pres = BMP180pres + oss * &H40 I2C WRITE BMP180address, 0, 2, BMP180control, BMP180temp Pause 5 I2C WRITE BMP180address, 0, 1, BMP180reading I2C READ BMP180address, 0, 2, BMPData(0) UT = BMPData(0) * 256 + BMPData(1) I2C WRITE BMP180address, 0, 2, BMP180control, pres ' different oversampling requires different reading times If (oss = 0) Then ' ulta low power Pause 5 ElseIf (oss = 1) Then ' standard Pause 8 ElseIf (oss = 2) Then ' high resolution Pause 14 Else ' ulta high resolution Pause 26 EndIf I2C WRITE BMP180address, 0, 1, BMP180reading I2C READ BMP180address, 0, 2, BMPData(0) UP = BMPData(0) * 256 + BMPData(1) I2C WRITE BMP180address, 0, 1, BMP180reading+2 I2C READ BMP180address, 0, 1, BMPData(0) UP = (UP * 256 + BMPData(0)) / 2^(8 - oss) ' calculate true temperature x1 = Int((UT - cal(6)) * cal(5) / 32768) x2 = Int(cal(10) * 2048 / (x1 + cal(11))) b5 = x1 + x2 t = Int((b5 + 8) / 16) / 10 ' calculate true atmospheric pressure b6 = b5 - 4000 x1 = Int((cal(8) * (b6 * b6 / 4096)) / 2048) x2 = Int(cal(2) * b6 / 2048) x3 = x1 + x2 b3 = Int(((cal(1) * 4 + x3) * 2^oss + 2) / 4) x1 = Int(cal(3) * b6 / 8192) x2 = Int((cal(7) * (b6 * b6 / 4096)) / 65536) x3 = Int(((x1 + x2) + 2) / 4) b4 = Int(cal(4) * x3 / 32768 + cal(4)) b7 = Int((UP - b3) * (50000 / 2^oss)) p = Int((b7 * 2) / b4) x1 = Int(Int(p / 256) * Int(p / 256)) x1 = Int((x1 * 3038) / 65536) x2 = Int((-7357 * p) / 65536) pressure = Int(p + (x1 + x2 + 3791) / 16) End Function ' Routine to draw multiple triangles, CSub DrawTriangles 00000000 27bdff90 afbf006c afbe0068 afb70064 afb60060 afb5005c afb40058 afb30054 afb20050 afb1004c afb00048 afa40070 afa50074 afa60078 afa7007c 8c820004 5c400007 afa00024 144000cc 8fbf006c 8c820000 104000ca 8fbe0068 afa00024 afa0002c 3c159d00 8fa30074 8fa40024 00641021 8c510000 8fa50078 00a41021 8c5e0000 8fa3007c 00641021 8c570000 8fa50080 00a41021 8c420000 afa20018 8fa30084 00641021 8c420000 afa20028 8fa50088 00a41021 8c560000 8fa3008c 00641021 8c540000 8fa40018 009e102a 10400008 8fa50018 03c01021 0080f021 afa20018 02201021 02e08821 0040b821 8fa50018 02c5102a 10400007 8fa30018 afb60018 00a0b021 02e01021 8fb70028 afa20028 8fa30018 007e102a 10400006 03c01021 0060f021 afa20018 02201021 02e08821 0040b821 17d6001b 8fa50018 02f1102a 14400006 02203821 0237102a 10400005 8fa40028 01000002 02e03821 02e08821 8fa40028 0091102a 54400003 8fb10028 00e4102a 0082380b 8ea20048 00fe3821 afb40010 8c420000 02202021 03c02821 02203021 0040f809 00f13823 01000063 8fa4002c 00b61026 0002102b 00a21023 afa2001c 005e102a 1440002f 03c08021 02f11023 afa20020 8fa30028 00711823 afa30030 00009021 00009821 00be2023 afa40034 02def823 afbe0038 afb7003c afb60040 0060f021 0080b821 03e0b021 0277001a 02e001f4 00002012 00912021 0256001a 02c001f4 00003012 00d13021 00c4102a 50400005 8ea20048 00801021 00c02021 00403021 8ea20048 afb40010 8c420000 02002821 0040f809 02003821 26100001 8fa20020 02629821 8fa3001c 0070102a 1040ffe6 025e9021 8fbe0038 8fb7003c 8fb60040 02d0102a 1440002a 8fa40028 00972023 afa4001c 8fa50018 02059023 72449002 8fa20028 00511023 afa20020 021e9823 70539802 02c51023 afa20018 02def023 8fa30018 0243001a 006001f4 00002012 00972021 027e001a 03c001f4 00003012 00d13021 00c4102a 50400005 8ea20048 00801021 00c02021 00403021 8ea20048 afb40010 8c420000 02002821 0040f809 02003821 26100001 8fa2001c 02429021 8fa30020 02d0102a 1040ffe5 02639821 8fa4002c 24840001 afa4002c 8fa50024 24a50008 afa50024 000417c3 8fa50070 8ca30004 0043182a 1460ff45 8fa30074 8ca30004 14620006 8fbf006c 8ca20000 0082202b 1480ff3e 8fa30074 8fbf006c 8fbe0068 8fb70064 8fb60060 8fb5005c 8fb40058 8fb30054 8fb20050 8fb1004c 8fb00048 03e00008 27bd0070 End CSub |
||||
RonnS Senior Member Joined: 16/07/2015 Location: GermanyPosts: 120 |
nice work Andrew, i like it !!! thanks for sharing Ron |
||||
Print this page |