GPS grid square finder πηγαίος κώδικας.

'gps
$regfile = "m16def.dat"
$crystal = 1000000
$baud = 4800
Config Porta = Input
Config Portd.2 = Input
Config Porta.0 = Output
Config Portb = Output
'Config Adc = Single , Prescaler = Auto , Reference = Internal
Config Lcdpin = Pin , Db4 = Portb.2 , Db5 = Portb.1 , Db6 = Portb.0 , Db7 = Porta.0 , E = Portb.3 , Rs = Portb.4
Config Lcd = 16 * 2
Dim A As String * 1
Dim I As Byte
Dim K As Byte
Dim J As Byte
Dim Screen As Byte
Dim L As String * 1
Dim Packet(100) As String * 1
Dim Gps_time(10) As String * 1
Dim Status(1) As String * 1
Dim Lat(9) As String * 1
Dim Lat_num(9) As Integer
Dim Lat_dir(1) As String * 1
Dim Lon(10) As String * 1
Dim Lon_num(9) As Integer
Dim Lon_dir(1) As String * 1
Dim Speed(6) As String * 1
Dim Z As String * 3
Dim Track(10) As String * 1
Dim Day(6) As String * 1
Dim Mag(5) As String * 1
Dim Temp As Single
Dim Temp2 As Single
Dim Temp3 As Integer
Dim Temp4 As Integer
Dim Temp5 As Single
Dim Height(6) As String * 1
Dim Pre(3) As String * 1
Dim Sat(3) As String * 1
Config Int0 = Rising
Declare Sub Coordinate_print
Declare Sub Letter(x As Integer)
Declare Sub Get_info
Declare Sub Get_info2
Declare Sub Lat_conversion
Declare Sub Lon_conversion
Declare Sub Grid
Declare Sub Square
Declare Sub Subsquare
Declare Sub Date_gps
Declare Sub Time_gps
On Int0 Button

Cursor Off                                                  'main program
Cls
Lcd "GPS GRID SQUARE"
Locate 2 , 1
Lcd "   BY SV1IXP"
Wait 3
I = 0
Screen = 1
Cls
Enable Int0
Enable Interrupts
   Do
   Call Get_info2
   Call Get_info
   Select Case Screen
   Case 2:
   Locate 1 , 1
   Lcd "LAT:"
   Locate 2 , 1
   Lcd "LON:"
   Call Lat_conversion
   Call Lon_conversion
   Call Coordinate_print
   Waitms 250
   Enable Interrupts
   Enable Int0
   Case 1 :
   Cls
   Locate 1 , 1
   Lcd "UTC: "
   Locate 2 , 1
   Lcd "GRID:"
   Locate 2 , 1
   Call Lat_conversion
   Call Lon_conversion
   Call Grid
   Call Square
   Call Subsquare
   Call Time_gps
   Waitms 250
   Enable Interrupts
   Enable Int0
   Case 3:
    Cls
    Locate 1 , 1
    Lcd "DATE: "
    Locate 2 , 1
    Lcd "HEIGHT: "
    Locate 2 , 9
    I = 1
    Do
    If Height(i) <> "," Then
    Lcd Height(i)
    End If
    I = I + 1
    Loop Until I = 7
    Lcd "m"
    Call Date_gps
    Waitms 250
    Enable Interrupts
   Enable Int0
   Case 4:
    Cls
    Lcd "SATS IN VIEW:"
    I = 2
    Do
    If Sat(i) <> "," Then
    Lcd Sat(i)
    End If
    I = I + 1
    Loop Until I = 4
    Locate 2 , 1
    Lcd "PRE:"
    I = 1
    Do
    Lcd Pre(i)
    I = I + 1
    Loop Until I = 4
    Waitms 250
     Enable Interrupts
   Enable Int0
   Case Else:
   Cls
   Lcd 55555
   Waitms 250
   Enable Interrupts
   Enable Int0
   End Select
   Loop
End



Sub Grid
        Temp2 = Lon_num(1) * 100
        Temp = Lon_num(2) * 10
        Temp = Temp + Lon_num(3)
        Temp = Temp + Temp2
        Lon_dir(1) = Packet(43)
          If Lon_dir(1) = "E" Then
          Temp = Temp + 180
          Else
          Temp = 180 - Temp
          End If
        Temp2 = Temp / 20
        Temp3 = Int(temp2)
        Call Letter(temp3)
        Locate 2 , 7
        Lcd L
        Temp2 = Lat_num(1) * 10
        Temp = Lat_num(2) * 1
        Temp = Temp + Temp2
          If Lat_dir(1) = "N" Then
          Temp = Temp + 90
          Else
          Temp = 90 - Temp
          End If
        Temp2 = Temp / 10
        Temp3 = Int(temp2)
        Call Letter(temp3)
        Lcd L
End Sub

Sub Square

        Temp2 = Lon_num(1) * 100
        Temp = Lon_num(2) * 10
        Temp = Temp + Lon_num(3)
        Temp = Temp + Temp2
        Lon_dir(1) = Packet(43)                             'prepei na allaksei
        If Lon_dir(1) = "E" Then
        Temp = Temp + 180
        Else
        Temp = 180 - Temp
        End If
        Temp2 = Temp / 20
        Temp2 = Int(temp2)
        Temp3 = Temp2
        Temp3 = Temp3 * 20
        Temp4 = Temp
        Temp4 = Temp4 - Temp3
        Temp = Temp4 / 2
        Temp = Int(temp)
        Temp4 = Temp
        Locate 2 , 9
        Lcd Temp4
        Temp2 = Lat_num(1) * 10
        Temp = Lat_num(2) * 1
        Temp = Temp + Temp2
        If Lat_dir(1) = "N" Then
        Temp = Temp + 90
        Else
        Temp = 90 - Temp
        End If
        Temp2 = Temp / 10
        Temp2 = Int(temp2)
        Temp3 = Temp2
        Temp3 = Temp3 * 10
        Temp4 = Temp
        Temp4 = Temp4 - Temp3
        Temp = Temp4 / 1
        Temp = Int(temp)
        Temp4 = Temp
        Lcd Temp4
End Sub

Sub Coordinate_print
K = 1
Locate 1 , 5
        Do
        Lcd Lat(k)
        K = K + 1
        Loop Until K = 10
        Lcd Lat_dir(1)
        K = 1
        Locate 2 , 5
         Do
        Lcd Lon(k)
        K = K + 1
        Loop Until K = 11
        Lcd Packet(43)
        End Sub

Sub Subsquare

Temp = Lon_num(1) * 100
Temp2 = Lon_num(2) * 10
Temp = Temp + Temp2
Temp2 = Lon_num(3) * 1
Temp = Temp + Temp2
Temp2 = Temp / 20
Temp2 = Int(temp2)
Temp2 = 20 * Temp2
Temp = Temp - Temp2
Temp2 = Temp / 2
Temp2 = Int(temp2)
Temp2 = 2 * Temp2
Temp = Temp - Temp2
Temp = Int(temp)
Temp = Temp * 60
Temp2 = Lon_num(4) * 10
Temp5 = Lon_num(5) * 1
Temp2 = Temp2 + Temp5
Temp5 = Lon_num(7) * 0.1
Temp2 = Temp2 + Temp5
Temp2 = Temp2 + Temp
Temp = Temp2 / 5
Temp = Int(temp)
Temp3 = Temp
Call Letter(temp3)
Locate 2 , 11
Lcd L

Temp = Lat_num(3) * 10
Temp2 = Lat_num(4)
Temp = Temp + Temp2
Temp2 = Lat_num(6) * 0.1
Temp = Temp + Temp2
Temp2 = Lat_num(7) * 0.001
Temp = Temp + Temp2
Temp = Temp / 2.5
Temp = Int(temp)
Temp3 = Temp
Call Letter(temp3)
Locate 2 , 12
Lcd L

End Sub

Sub Get_info
     Begin:
     Do
     A = Waitkey()
     Loop Until A = "$"
   I = 0
     Do
     A = Waitkey()
     I = I + 1
     Packet(i) = A
     Loop Until I = 80 Or A = "*"
     If Packet(5) = "C" And Packet(3) = "R" And Packet(4) = "M" Then       'check packet if ok
     I = 7
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       Gps_time(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       Status(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       Lat(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       Lat_dir(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       Lon(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       Lon_dir(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
       Do                                                   'void
       A = Packet(i)
       I = I + 1
       Speed(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
                                             'void
       Do
       A = Packet(i)
       I = I + 1
       Track(j) = A
       J = J + 1
       Loop Until A = ","
    J = 1
       Do
       A = Packet(i)
       I = I + 1
       Day(j) = A
       J = J + 1
       Loop Until A = ","
    J = 1
       Do                                                   'void
       A = Packet(i)
       I = I + 1
       Mag(j) = A
       J = J + 1
       Loop Until A = ","
       Else
       Goto Begin:
       End If
       End Sub

Sub Get_info2
     Begin2:
     Do
     A = Waitkey()
     Loop Until A = "$"
   I = 0
     Do
     A = Waitkey()
     I = I + 1
     Packet(i) = A
     Loop Until I = 80 Or A = "*"
     If Packet(5) = "A" And Packet(3) = "G" And Packet(4) = "G" Then       'check packet if ok
     I = 7
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
     J = 1
       Do
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
     J = 1
       Do                                                   'void
       A = Packet(i)
       I = I + 1
       Sat(j) = A
       J = J + 1
       Loop Until A = ","
     J = 1
                                             'void
       Do
       A = Packet(i)
       I = I + 1
       Pre(j) = A
       J = J + 1
       Loop Until A = ","
    J = 1
       Do
       A = Packet(i)
       I = I + 1
       Height(j) = A
       J = J + 1
       Loop Until A = ","
    J = 1
       Do                                                   'void
       A = Packet(i)
       I = I + 1
       J = J + 1
       Loop Until A = ","
       Else
       Goto Begin2:
       End If
       End Sub

Sub Lat_conversion
K = 0
        Do
        K = K + 1
        Lat_num(k) = Val(lat(k))
        Loop Until K = 9
End Sub

Sub Lon_conversion
K = 0
        Do
        K = K + 1
        Lon_num(k) = Val(lon(k))
        Loop Until K = 10
End Sub

Sub Time_gps
Locate 1 , 6
        K = 1
        Do
        Lcd Gps_time(k)
        K = K + 1
        Loop Until K = 3
        Lcd ":"
        Do
        Lcd Gps_time(k)
        K = K + 1
        Loop Until K = 5
        Lcd ":"
        Do
        Lcd Gps_time(k)
        K = K + 1
        Loop Until K = 7
End Sub

Sub Date_gps
Locate 1 , 7
        K = 1
        Do
        Lcd Day(k)
         K = K + 1
        Loop Until K = 3
        Lcd "/"
        Do
        Lcd Day(k)
        K = K + 1
        Loop Until K = 5
        Lcd "/"
        Do
        Lcd Day(k)
        K = K + 1
        Loop Until K = 7
End Sub

Sub Letter(x As Integer)

    Select Case Temp3
    Case 0 : L = "A"
    Case 1 : L = "B"
    Case 2 : L = "C"
    Case 3 : L = "D"
    Case 4 : L = "E"
    Case 5 : L = "F"
    Case 6 : L = "G"
    Case 7 : L = "H"
    Case 8 : L = "I"
    Case 9 : L = "J"
    Case 10 : L = "K"
    Case 11 : L = "L"
    Case 12 : L = "M"
    Case 13 : L = "N"
    Case 14 : L = "O"
    Case 15 : L = "P"
    Case 16 : L = "Q"
    Case 17 : L = "R"
    Case 18 : L = "S"
    Case 19 : L = "T"
    Case 20 : L = "U"
    Case 21 : L = "V"
    Case 22 : L = "W"
    Case 23 : L = "X"
    Case 24 : L = "Y"
    Case 25 : L = "Z"
    Case Else L = "*"
    End Select
End Sub

Button:
Disable Interrupts
Disable Int0
Screen = Screen + 1

      If Screen = 5 Then
      Screen = 1
      End If
Waitms 100
      While Pind.2 = 1
      Wend
      Waitms 200
      Cls
Return