rem    RADIO program V1.0.  For Lowe HF-150 receiver / IF-150 interface
rem    Source code for Microsoft QB compiler V3.0
rem    J. R. Thorpe.  October 1992

rem    Public domain - No copyright exists on this program.


Init:
   const maxrec = 1199, yes = -1, no = 0
   defint a-z : rem $dynamic
   dim dbgrp(maxrec), dbfrq#(maxrec), dbmod(maxrec), dbinf$(maxrec)
   dim boxcon(24,2), box$(24)


Mouseinit:
   def seg = 0
   mouseseg! = peek(&h0CE)+256!*peek(&h0CF)
   mouse! = 2+peek(&h0CC)+256!*peek(&h0CD)
   mouse = mouse!+65536*(mouse!>32768)
   mouseseg = mouseseg!+65536*(mouseseg!>32768)
   def seg = mouseseg
   mousedriver = peek(mouse-2)<>&hcf
   m=0 : gosub mousecall


Def fnfr$(x#)
         static i$
         i$ = "."+right$("00"+str$(x#),3)
         if i$=".000" then
               i$="    "
            elseif right$(i$,2)="00" then
               i$ = left$(i$,2)+"  "
            elseif right$(i$,1)="0" then
               i$ = left$(i$,3)+" "
         end if
         fnfr$ = right$("    "+str$(int(x#/1000)),5)+i$
end def

Def fncomp(x,y)
         if dbgrp(x)<>dbgrp(y) then
               fncomp = dbgrp(x)>dbgrp(y)
            else
               fncomp = dbfrq#(x)=>dbfrq#(y)
         end if
end def


Def fnmod(x$)
         select case left$(x$+" ",3)
            case "lsb","LSB" : fnmod = 1
            case "usb","USB" : fnmod = 2
            case "amn","AMN" : fnmod = 3
            case "am ","AM " : fnmod = 4
            case "ams","AMS" : fnmod = 5
            case "asd","ASD" : fnmod = 5
            case "asf","ASF" : fnmod = 6
            case "asu","ASU" : fnmod = 7
            case "asl","ASL" : fnmod = 8
            case "cw ","CW " : fnmod = 9
            case else : fnmod = 0
         end select
end def


Def fnmd$(x) = mid$("   lsbusbamnam asdasfaslasucw ",x*3+1,3)


Def fntr$(x$)
         static x
         for x=len(x$) to 1 step -1
            if mid$(x$,x,1)<>" " then exit for
         next x
         fntr$ = left$(x$,x)
end def


Main:
   gosub readinifile : gosub drawscreen : locate 25,13
   print "  ###     RADIO V1.0 for LOWE HF150 receiver     ###  ";
   color 10,1 : print "   Esc = Exit";
   dblen = -1 : gosub readdatabase
   dbstart = 0 : dbsel = 0 : gosub displaystations : gosub highlight
   open "com"+mid$(str$(comport),2)+":1200,n,8,1,rs,cs0,ds0,cd0" as #2
   comopen = comport : rxdelay! = 0
   endprog = no : dbupdate = no
   radiofrq# = 0 : radiomode = 0 : radiomem = 1
   do
      autodelay! = 0.5
      m=1 : gosub mousecall
      gosub readmouse
      gosub readkey
   loop until endprog
   m=2 : gosub mousecall
   color 7,0 : cls
end


Selectradio:
         if dbfrq#(dbsel)=0 then return
         radiofrq# = dbfrq#(dbsel)
         radiomode = dbmod(dbsel)
         if radiomode=9 then
            if offsetcw<0 then radiomode = 1 else radiomode = 2
            radiofrq# = radiofrq#-offsetcw
         end if
         gosub displayfrq : gosub displaymode
         gosub receivefrq : goto receivemode


Memset:
         restore memline : gosub displayline
         e$ = mid$(str$(radiomem)+"  ",2,2) : color 15,6
         restore memscreen : gosub lineedit
         select case exitchar

            case 3341           ' Enter
               radiomem = val(e$)
               gosub displaymem

            case 6939           ' Cancel
               gosub displaymem

         end select
         restore clearline : goto displayline

Memline:
   data 1,10,1,-1,"    Press ENTER to set memory number or ESC to cancel",999

Memscreen:
   data 16,20,21,3341,6939


Memstore:
         gosub receivestore
         radiomem = radiomem+1+60*(radiomem>59)
         goto displaymem


Memrecall:
         radiofrq# = 0 : radiomode = 0
         gosub displayfrq : gosub displaymode
         gosub receiverecall
         radiomem = radiomem+1+60*(radiomem>59)
         goto displaymem


Frqtunedn1:
         if (radiomode>2) and (radiomode<7) then frq# = -100 else frq# = -10
         goto frqtune

Frqtunedn2:
         frq# = -1000 : goto frqtune

Frqtuneup1:
         if (radiomode>2) and (radiomode<7) then frq# = 100 else frq# = 10
         goto frqtune

Frqtuneup2:
         frq# = 1000 : goto frqtune

Frqtune:
         if radiofrq#>0 then
            if (abs(frq#)>500) and (radiomode>2) and (radiomode<7) then
               if radiofrq#<1650000 then frq# = frq#*mwstep else frq# = frq#*5
               radiofrq# = abs(frq#)*int((radiofrq#/abs(frq#))+0.5)
            end if
            radiofrq# = radiofrq#+frq#
            gosub displayfrq
            goto receivefrq
         end if
         return


Frqedit:
         restore frqline : gosub displayline
         e$ = fnfr$(radiofrq#) : color 15,6
         restore frqscreen : gosub lineedit
         select case exitchar

            case 3341           ' Enter
               radiofrq# = int(1000*val(e$))
               gosub displayfrq
               gosub receivefrq

            case 6939           ' Cancel
               gosub displayfrq

         end select
         restore clearline : goto displayline

Frqline:
   data 1,10,1,-1,"    Press ENTER to tune or ESC to cancel",999

Frqscreen:
   data 10,8,16,3341,6939


Modeprev:
         radiomode = radiomode-1-8*(radiomode<2)
         gosub displaymode
         goto receivemode


Modenext:
         radiomode = radiomode+1+8*(radiomode>7)
         gosub displaymode
         goto receivemode


Fileops:
         oldfile$ = dbfile$
         locate 6,34
         restore filebox : gosub drawdata
         locate 9,43 : print using"####";dblen+1
         box$(16) = dbfile$
         color 15,6 : restore filescreen : gosub windowedit
         select case exitline

            case 11             ' Load new
               if dbupdate then
                  restore scmline : gosub displayline
                  gosub yesno
                  if reply then gosub savedatabase
                  dbupdate = no
               end if
               dbfile$ = fntr$(box$(16))
               gosub saveinifile
               dblen = -1 : gosub readdatabase
               dbstart = 0 : dbsel = 0

            case 12             ' Merge
               dbfile$ = fntr$(box$(16)) : reply = yes
               if dbfile$=oldfile$ then_
                  restore msfline : gosub displayline : gosub yesno
               if reply then
                  gosub readdatabase
                  dbstart = 0 : dbsel = 0
                  dbfile$ = oldfile$
               end if

            case 13             ' Save
               dbfile$ = fntr$(box$(16))
               gosub saveinifile
               gosub savedatabase

            case 14             ' Exit

         end select
         gosub displaystations : gosub highlight
         goto mousewait

Scmline:
   data 1,10,1,-1,"    Save current modified database first",999

Msfline:
   data 1,10,1,-1,"    Merge in same file",999

Filescreen:
   data 37,73,8,17
   data 0,0,0,0,0,0,0,0,0,0,0,66,0,0,67,0,0,68,0,0,6939
   data 0,0,0,48,72,0,0,0,0

Filebox:
   data 1,0,0,39,32,0,34,2,32,1,14,2,-201,15,205,-181
   data 1,15,5,-1," FILE ",1,14,2,-198,14,205,-187,0,34
   data 1,0,0,2,32,1,14,2,-186,37,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,11,32,-1,stations,18,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,37,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,6,32,1,15,5
   data -1,F8,1,14,2,-1,"  Load new database",10,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,6,32,1,15,5
   data -1,F9,1,14,2,-1,"  Merge in new database",6,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,6,32,1,15,5
   data -1,F10,1,14,2,-1," Save database",14,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,6,32,1,15,5
   data -1,Esc,1,14,2,-1," Exit file operations",7,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,37,32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,-1," File name "
   data 1,0,0,25,32,1,14,2,-32,-186,0,34
   data 1,0,0,2,32,1,14,2,-186,37,32,-186,0,36,-200,37,205,-188,999


Setup:
         locate 7,36
         restore setupbox : gosub drawdata
         box$(13) = mid$(str$(comport),2)
         box$(14) = str$(offsetf!) : box$(15) = str$(offsetp!)
         box$(16) = str$(offsetcw) : box$(17) = str$(mwstep)
         restore setupscreen : gosub windowedit
         select case exitline

            case 10             ' Update
               comport = val(box$(13))
               if (comport<1) or (comport>3) then comport = comopen
               offsetf! = val(box$(14)) : offsetp! = val(box$(15))
               offsetcw = val(box$(16)) : mwstep = val(box$(17))
               gosub saveinifile
               if comopen<>comport then
                  close 2
                  open "com"+mid$(str$(comport),2)+_
                     ":1200,n,8,1,rs,cs0,ds0,cd0" as #2
                  comopen = comport
               end if

            case 11             ' Cancel

         end select
         gosub displaystations : gosub highlight
         goto mousewait

Setupscreen:
   data 39,71,9,18
   data 0,0,0,0,0,68,0,0,6939,0,0,0
   data 63,63,0,60,64,0,60,64,0,60,64,0,60,64,0,,0,0,0

Setupbox:
   data 1,0,0,35,32,0,36,2,32,1,14,2,-201,12,205,-181
   data 1,15,5,-1," SETUP ",1,14,2,-198,12,205,-187,0,36
   data 1,0,0,2,32,1,14,2,-186,33,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,4,32,1,15,5
   data -1,F10,1,14,2,-1," Save this setup",10,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,4,32,1,15,5
   data -1,Esc,1,14,2,-1," Cancel setup operation   ",-186,0,36
   data 1,0,0,2,32,1,14,2,-186,33,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,-1," Serial port",9,32,-1,COM
   data 1,0,0,-32,1,14,2,-58,7,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,-1," Fixed offset",8,32
   data 1,0,0,5,32,1,14,2,-1,Hz,5,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,-1," Proportional offset "
   data 1,0,0,5,32,1,14,2,-1,"Hz/MHz ",-186,0,36
   data 1,0,0,2,32,1,14,2,-186,-1," CW tone",13,32
   data 1,0,0,5,32,1,14,2,-1,Hz,5,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,-1," MW channel step",5,32
   data 1,0,0,5,32,1,14,2,-1,kHz,4,32,-186,0,36
   data 1,0,0,2,32,1,14,2,-186,33,32,-186,0,38,-200,33,205,-188,1,15,6,999


Dataadd:
         locate 7,32
         restore addboxtop : gosub drawdata
         restore editbox : gosub drawdata
         box$(13) = chr$(dbgrp(dbsel)) : box$(14) = fnfr$(radiofrq#)
         box$(15) = fnmd$(radiomode) : box$(16) = ""
         restore addscreen : gosub windowedit
         select case exitline

            case 10             ' Add
               grp = asc(box$(13)) : frq# = int(1000*val(box$(14)))
               mode = fnmod(box$(15)) : inf$ = fntr$(box$(16))
               gosub adddata

            case 11             ' Cancel

         end select
         gosub displaystations : gosub highlight
         goto mousewait
         return

Addscreen:
   data 35,74,9,17
   data 0,0,0,0,0,68,0,0,6939,0,0,0
   data 46,46,0,46,54,0,46,48,0,42,73,0,0,0,0

Addboxtop:
   data 1,0,0,42,32,0,32,2,32,1,14,2,-201,16,205,-181
   data 1,15,5,-1," ADD ",1,14,2,-198,17,205,-187,0,32
   data 1,0,0,2,32,1,14,2,-186,40,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,8,32,1,15,5
   data -1,F10,1,14,2,-1," Add this station",12,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,8,32,1,15,5
   data -1,Esc,1,14,2,-1," Cancel add operation",8,32,-186,0,32,999


Dataedit:
         locate 6,32
         restore editboxtop : gosub drawdata
         box$(13) = chr$(dbgrp(dbsel)) : box$(14) = fnfr$(dbfrq#(dbsel))
         box$(15) = fnmd$(dbmod(dbsel)) : box$(16) = dbinf$(dbsel)
         if dbfrq#(dbsel)=0 then box$(14) = " Heading"
         restore editscreen : gosub windowedit
         select case exitline

            case 9              ' Delete
               restore csdline : gosub displayline
               gosub yesno
               if reply then gosub deletedata

            case 10             ' Update
               if (box$(13)=chr$(dbgrp(dbsel)))_
                  and (1000*val(box$(14))=dbfrq#(dbsel)) then
                     dbmod(dbsel) = fnmod(box$(15))
                     dbinf$(dbsel) = fntr$(box$(16))
                     dbupdate = yes
                  else
                     gosub deletedata
                     grp = asc(box$(13)) : frq# = int(1000*val(box$(14)))
                     mode = fnmod(box$(15)) : inf$ = fntr$(box$(16))
                     gosub adddata
               end if

            case 11             ' Cancel

         end select
         gosub displaystations : gosub highlight
         goto mousewait

Csdline:
   data 1,10,1,-1,"    Confirm : Station is to be deleted",999

Editscreen:
   data 35,74,8,17
   data 0,0,0,0,0,67,0,0,68,0,0,6939,0,0,0
   data 46,46,0,46,54,0,46,48,0,42,73,0,0,0,0

Editboxtop:
   data 1,0,0,42,32,0,32,2,32,1,14,2,-201,16,205,-181
   data 1,15,5,-1," EDIT ",1,14,2,-198,16,205,-187,0,32
   data 1,0,0,2,32,1,14,2,-186,40,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,8,32,1,15,5
   data -1,F9,1,14,2,-1,"  Delete this entry",11,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,8,32,1,15,5
   data -1,F10,1,14,2,-1," Update this entry",11,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,8,32,1,15,5
   data -1,Esc,1,14,2,-1," Cancel edit operation",7,32,-186,0,32

Editbox:
   data 1,0,0,2,32,1,14,2,-186,40,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,-1," Group",34,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,-1," Frequency",30,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,-1," Mode",35,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,-1," Ident",34,32,-186,0,32
   data 1,0,0,2,32,1,14,2,-186,40,32,-186,0,34,-200,40,205,-188,1,15,6,999


Selectline:
         p = dbstart+int(mpos/100)-3
         if p=dbsel goto selectradio
         gosub unhighlight
         if p<=dblen then dbsel = p
         goto highlight


Selectup:
         gosub unhighlight
         if dbsel>0 then dbsel = dbsel-1
         if (dbsel<dbstart+2) and (dbstart>0) then
               dbstart = dbstart-15
               if dbstart<0 then dbstart = 0
               gosub displaystations
         end if
         goto highlight


Selectdown:
         gosub unhighlight
         if dbsel<dblen then dbsel = dbsel+1
         if (dbsel>dbstart+17) and (dbstart<dblen-10) then
               dbstart = dbstart+15
               if dbstart>dblen-19 then dbstart = dblen-19
               gosub displaystations
         end if
         goto highlight


Selectpageup:
         if (dbstart<=0) and (dbsel<=0) then return
         dbstart = dbstart-18 : dbsel = dbsel-18
         if dbstart<0 then dbstart = 0
         if dbsel<0 then dbsel = 0
         gosub displaystations : goto highlight


Selectpagedown:
         if (dbstart=>dblen-19) and (dbsel=>dblen) then return
         dbstart = dbstart+18 : dbsel = dbsel+18
         if dbstart>dblen-19 then dbstart = dblen-19
         if dbsel>dblen then dbsel = dblen
         gosub displaystations : goto highlight


Findgroup:
         for x=0 to dblen
            if dbgrp(x)=asc(i$) then
               dbsel = x : dbstart = dbsel-2
               if dbstart<0 then dbstart = 0
               exit for
            end if
         next x
         gosub displaystations : goto highlight


Readkey:
         i$ = inkey$
         if i$="" then return
         select case 256*asc(left$(i$,1))+asc(right$(i$,1))

            case 6939           ' ESC
               goto checkend

            case 59             ' F1
               goto frqedit

            case 60             ' F2
               goto memset

            case 61             ' F3
               goto memstore

            case 62             ' F4
               goto memrecall

            case 63             ' F5
               goto dataadd

            case 64             ' F6
               goto dataedit

            case 65             ' F7
               goto fileops

            case 66             ' F8
               goto setup

            case 11565,24415    ' -
               goto frqtunedn1

            case 11051,15677    ' +
               goto frqtuneup1

            case 11308,15420    ' <
               goto frqtunedn2

            case 11822,15934    ' >
               goto frqtuneup2

            case 75             ' Left arrow
               goto modeprev

            case 77             ' Right arrow
               goto modenext

            case 72             ' Up arrow
               goto selectup

            case 80             ' Down arrow
               goto selectdown

            case 73             ' Page up
               goto selectpageup

            case 81             ' Page down
               goto selectpagedown

            case 3341           ' Enter
               goto selectradio

            case 12336 to 32382 ' Group letters
               goto findgroup

            case else
               print chr$(7);

         end select
         return


Readmouse:
         if mousedriver then
               m=3 : gosub mousecall
               if (m2 and 1)=0 then return
            else return
         end if
         mpos = m4*100/8+m3/8+101
   rdm1: select case mpos

            case 2570 to 2579   ' Exit
               gosub checkend

            case 0908 to 0910   ' Fine down
               gosub frqtunedn1

            case 0917 to 0919   ' Fine up
               gosub frqtuneup1

            case 0904 to 0906   ' Coarse down
               gosub frqtunedn2

            case 0921 to 0923   ' Coarse up
               gosub frqtuneup2

            case 0702 to 0725, 1002 to 1025
               gosub frqedit

            case 0304 to 0323, 0404 to 0423
               radiomode = int((mpos-299)/5)+16*(mpos>400)
               gosub displaymode
               gosub receivemode

            case 1302 to 1325, 1520 to 1522, 1620 to 1622
               gosub memset

            case 1505 to 1509, 1605 to 1609
               gosub memstore

            case 1512 to 1517, 1612 to 1617
               gosub memrecall

            case 2105 to 2107, 2205 to 2207
               gosub dataadd

            case 2109 to 2112, 2209 to 2212
               gosub dataedit

            case 2114 to 2117, 2214 to 2217
               gosub fileops

            case 2119 to 2123, 2219 to 2223
               gosub setup

            case 0173 to 0178   ' Page up
               gosub selectpageup
               goto autorepeat

            case 2373 to 2378   ' Page down
               gosub selectpagedown
               goto autorepeat

            case 0171           ' Down arrow
               gosub selectdown
               goto autorepeat

            case 0169           ' Up arrow
               gosub selectup
               goto autorepeat

            case 0120,0121      ' Left arrow
               gosub modeprev

            case 0123,0124      ' Right arrow
               gosub modenext

            case 0329 to 0378, 0429 to 0478, 0529 to 0578, 0629 to 0678,_
                 0729 to 0778, 0829 to 0878, 0929 to 0978, 1029 to 1078,_
                 1129 to 1178, 1229 to 1278, 1329 to 1378, 1429 to 1478,_
                 1529 to 1578, 1629 to 1678, 1729 to 1778, 1829 to 1878,_
                 1929 to 1978, 2029 to 2078, 2129 to 2178, 2229 to 2278
               gosub selectline

            case else
         end select
         goto mousewait

Autorepeat:
         time! = timer
         do
            m=1 : gosub mousecall : m=3 : gosub mousecall
         loop while (m2 and 1) and (time!+autodelay! > timer)
         if (m2 and 1) then autodelay! = 0.09 : goto rdm1
         return


Checkend:
         endprog = yes : reply = no
         if dbupdate then restore smdline : gosub displayline : gosub yesno
         if reply then gosub savedatabase
         restore epline : gosub displayline
         gosub yesno : endprog = reply
         return

Smdline:
   data 1,10,1,-1,"    Save modified database",999

Epline:
   data 1,10,1,-1,"    Exit program",999


Mousecall:
         if mousedriver then
            m1 = m : m2 = 0 : m3 = 0 : m4 = 0
            call absolute (m1,m2,m3,m4,mouse)
            if m=0 then_
               m1=4 : m2=0 : m3=0 : m4=184 : call absolute (m1,m2,m3,m4,mouse)
         end if
         return


Mousewait:
         if mousedriver then
            do
               m=1 : gosub mousecall
               m=3 : gosub mousecall
            loop while (m2 and 1)
            end if
         return


Adddata:
         if dblen=>maxrec goto databasefull
         dbupdate = yes : dblen = dblen+1
         dbgrp(dblen) = grp : dbfrq#(dblen) = frq#
         dbmod(dblen) = mode : dbinf$(dblen) = inf$
         for x=0 to dblen-1
            if fncomp(x,dblen) then
               for y=dblen-1 to x step -1
                  dbgrp(y+1) = dbgrp(y) : dbfrq#(y+1) = dbfrq#(y)
                  dbmod(y+1) = dbmod(y) : dbinf$(y+1) = dbinf$(y)
               next y
               dbgrp(x) = grp : dbfrq#(x) = frq#
               dbmod(x) = mode : dbinf$(x) = inf$
               exit for
            end if
         next x
         dbsel = x : dbstart = dbsel-9
         if dbstart<0 then dbstart = 0
         return


Databasefull:
         restore dbfline : gosub displayline
         for x=1 to 5
            print chr$(7);
            time! = timer+0.5
            do : loop while (timer>time!-1) and (timer<time!)
         next x
         restore clearline : gosub displayline

Dbfline:
   data 1,1,14,-1,"******    Database full    ******",999


Deletedata:
         if dblen=>0 then
            for x=dbsel+1 to dblen
               dbgrp(x-1) = dbgrp(x) : dbfrq#(x-1) = dbfrq#(x)
               dbmod(x-1) = dbmod(x) : dbinf$(x-1) = dbinf$(x)
            next x
            dbupdate = yes : dblen = dblen-1
            if dbsel>dblen then dbsel = dblen
         end if
         return


Readdatabase:
         restore rsdline : gosub displayline
         open dbfile$ for random as #1 : close 1
         open dbfile$ for input as #1
         for x=dblen+1 to maxrec
            if eof(1) goto rdb3
            line input#1,i$ : if i$="" goto rdb3
            dbgrp(x) = asc(left$(i$,1))
            dbfrq#(x) = int(val(mid$(i$,2,11))*1000)
            dbmod(x) = fnmod(mid$(i$,13,3))
            dbinf$(x) = fntr$(mid$(i$,17))
            if x=0 goto rdb2
            if fncomp(x,x-1) goto rdb2
            for y=x-2 to 0 step-1
               if fncomp(x,y) then y = y+1 : goto rdb1
            next y : y = 0
   rdb1:    grp = dbgrp(x) : frq# = dbfrq#(x)
            mode = dbmod(x) : inf$ = dbinf$(x)
            for z=x-1 to y step -1
               dbgrp(z+1) = dbgrp(z)
               dbfrq#(z+1) = dbfrq#(z)
               dbmod(z+1) = dbmod(z)
               dbinf$(z+1) = dbinf$(z)
            next z
            dbgrp(y) = grp : dbfrq#(y) = frq#
            dbmod(y) = mode : dbinf$(y) = inf$
   rdb2: next x : : gosub databasefull : x = maxrec+1
   rdb3: dblen = x-1
         close 1
         if dblen<0 then
            dbgrp(0) = 32 : dbfrq#(0) = 0
            dbmod(0) = 0 : dbinf$(0) = ""
         end if
         restore clearline : gosub displayline
         return

Rsdline:
   data 1,10,1,-1,"    Reading station data ...",52,32,999


Savedatabase:
         restore ssdline : gosub displayline
         open dbfile$ for output as #1
         for x=0 to dblen
            print#1,chr$(dbgrp(x)) " " fnfr$(dbfrq#(x)) " " fnmd$(dbmod(x))_
               " " dbinf$(x)
         next x
         close 1
         restore clearline : gosub displayline
         dbupdate = no : return

Ssdline:
   data 1,10,1,-1,"    Saving station data ...",53,32,999


Readinifile:
         open "radio.ini" for random as #1 : close 1
         open "radio.ini" for input as #1
         if eof(1) goto rif1
         input#1,i$ : if i$="" goto rif1
         comport = val(i$)
         input#1,offsetf! : input#1,offsetp!
         input#1,offsetcw : input#1,mwstep
         line input#1,dbfile$
         close 1
         return

   rif1: close 1
         comport = 1
         offsetf! = 0 : offsetp! = 0
         offsetcw = 800
         mwstep = 9
         dbfile$ = "radio.dat"


Saveinifile:
         open "radio.ini" for output as #1
         print#1,comport
         print#1,offsetf! : print#1,offsetp!
         print#1,offsetcw : print#1,mwstep
         print#1,dbfile$
         close 1
         return


Lineedit:
         read eline,wxmin,wxmax,exit1,exit2 : insert = no
         m=2 : gosub mousecall
         locate eline,wxmin : ecsr = wxmin
         print left$(e$+space$(80),1+wxmax-wxmin)
         do
            locate eline,ecsr,1,-6*insert,7
            do : i$ = inkey$ : loop until i$<>""
            d = 256*asc(left$(i$,1))+asc(right$(i$,1))
            select case d

               case 82          ' Insert
                  insert = not(insert)

               case 83          ' Delete
                  e$ = ""
                  for x=ecsr to wxmax
                     e$ = e$+chr$(screen(eline,x))
                  next x
                  print mid$(e$+" ",2)

               case 2056        ' Backspace
                  if ecsr>wxmin then
                     e$ = "" : ecsr = ecsr-1
                     for x=ecsr+1 to wxmax
                        e$ = e$+chr$(screen(eline,x))
                     next x
                     locate eline,ecsr
                     print e$;" "
                  end if

               case 3341        ' Enter
                  if (insert=no) and (ecsr>wxmin) then_
                     print space$(1+wxmax-ecsr)
                  ecsr = wxmin

               case 75          ' Left
                  if ecsr>wxmin then ecsr = ecsr-1

               case 77          ' Right
                  if ecsr<wxmax then ecsr = ecsr+1

               case 8224 to 32382
                  if ecsr>wxmax then
                        print chr$(7);
                     else
                        e$ = ""
                        if insert then
                           for x=ecsr to wxmax-1
                              e$ = e$+chr$(screen(eline,x))
                           next x
                        end if
                        print i$;e$;
                        ecsr = ecsr+1
                  end if

               case else

            end select
         loop until (d=exit1) or (d=exit2)
         exitchar = d : e$ = ""
         for x=wxmin to wxmax
            e$=e$+chr$(screen(eline,x))
         next x
         locate ,,0,6,7 : color 10,1
         return


Windowedit:
         read wxmin,wxmax,wymin,wymax
         for x=wymin to wymax
            read boxcon(x,0), boxcon(x,1), boxcon(x,2)
         next x
         if mousedriver then
               m1 = 7 : m2 = 0
               m3 = wxmin*8-8 : m4 = wxmax*8-8
               call absolute (m1,m2,m3,m4,mouse)
               m1 = 8 : m2 = 0
               m3 = wymin*8-8 : m4 = wymax*8-8
               call absolute (m1,m2,m3,m4,mouse)
         end if
         m=2 : gosub mousecall
         for x=wymin to wymax
            if boxcon(x,0) then
               locate x,boxcon(x,0)
               print left$(box$(x)+space$(80),1+boxcon(x,1)-boxcon(x,0))
            end if
         next x
         eline = wymin-1 : gosub enext : insert = no
   wed1: ecsr = boxcon(eline,0)
   wed2: locate eline,ecsr,1,-6*insert,7
   wed3: m=1 : gosub mousecall
         i$ = inkey$
         if i$<>"" then
            m=2 : gosub mousecall
            d = 256*asc(left$(i$,1))+asc(right$(i$,1))
            select case d

               case 82          ' Insert
                  insert = not(insert)

               case 83          ' Delete
                  e$ = ""
                  for x=ecsr to boxcon(eline,1)
                     e$ = e$+chr$(screen(eline,x))
                  next x
                  print mid$(e$+" ",2)

               case 2056        ' Backspace
                  if ecsr>boxcon(eline,0) then
                     e$ = "" : ecsr = ecsr-1
                     for x=ecsr+1 to boxcon(eline,1)
                        e$ = e$+chr$(screen(eline,x))
                     next x
                     locate eline,ecsr
                     print e$;" "
                  end if

               case 3341        ' Enter
                  if (insert=no) and (ecsr>boxcon(eline,0)) then_
                     print space$(1+boxcon(eline,1)-ecsr)
                  gosub enext : goto wed1

               case 72          ' Up
                  gosub eprev : goto wed1

               case 80          ' Down
                  gosub enext : goto wed1

               case 75          ' Left
                  if ecsr>boxcon(eline,0) then ecsr = ecsr-1

               case 77          ' Right
                  if ecsr<boxcon(eline,1) then ecsr = ecsr+1

               case 8224 to 32382
                  if ecsr>boxcon(eline,1) then print chr$(7); : goto wed2
                  e$ = ""
                  if insert then
                     for x=ecsr to boxcon(eline,1)-1
                        e$ = e$+chr$(screen(eline,x))
                     next x
                  end if
                  print i$;e$;
                  ecsr = ecsr+1

               case else
                  for x=wymin to wymax
                     if d=boxcon(x,2) then exitline = x : goto wed4
                  next x
                  print chr$(7);

            end select
            goto wed2
         end if
         if mousedriver then
            m=3 : gosub mousecall
            if (m2 and 1)=0 goto wed3
            mpos = m4/8+1
            if boxcon(mpos,2) then exitline = mpos : goto wed4
            if boxcon(mpos,0) then
               eline = mpos : ecsr = boxcon(eline,0)
               mpos = m3/8+1
               if (mpos>boxcon(eline,0)) and (mpos<=boxcon(eline,1)) then_
                  ecsr = mpos
               locate eline,ecsr,1
            end if
            gosub mousewait
         end if
         goto wed3

   wed4: for x=wymin to wymax
            box$(x)=""
            if boxcon(x,0) then
               for y=boxcon(x,0) to boxcon(x,1)
                  box$(x)=box$(x)+chr$(screen(x,y))
               next y
            end if
         next x
         locate ,,0,6,7 : color 10,1
         m=0 : goto mousecall

Enext:   do
            for x=eline+1 to wymax
               if boxcon(x,0) then eline = x : exit do
            next x
            eline = wymin-1
         loop : return

Eprev:   do
            for x=eline-1 to wymin step-1
               if boxcon(x,0) then eline = x : exit do
            next x
            eline = wymax+1
         loop : return


Receivemode:
         gosub receivewait
         print #2,"Mod" mid$("LsbUsbAMnAM ASdASfASlASu",radiomode*3-2,3)
         rxdelay! = timer+0.1
         return


Receivefrq:
         gosub receivewait
         frq# = offsetf!+(1+offsetp!/1000)*radiofrq#
         print #2,"Frq" fnfr$(frq#)
         rxdelay! = timer+0.8
         return


Receiverecall:
         gosub receivewait
         print #2,"Rcl" radiomem
         rxdelay! = timer+0.3
         return


Receivestore:
         gosub receivewait
         print #2,"Sto" radiomem
         rxdelay! = timer+0.2
         return


Receivewait:
         do : loop while (timer>rxdelay!-1) and (timer<rxdelay!)
         return


Displaymem:
         color 10,1 : locate 16,20
         m=2 : gosub mousecall
         print mid$(str$(radiomem)+"  ",2,2);
         m=1 : goto mousecall


Displayfrq:
         color 10,1 : locate 10,8
         m=2 : gosub mousecall
         if radiofrq#>0 then print fnfr$(radiofrq#); : else print "*********";
         m=1 : goto mousecall


Displaymode:
         m=2 : gosub mousecall
         for x=1 to 8
            if x=radiomode then color 1,11 else color 10,1
            locate 4+(x<5),x*5+(x>4)*20-1
            print mid$(" LSB USB AMN AM  ASD ASF ASL ASU ",x*4-3,5);
         next x
         color 10,1
         m=1 : goto mousecall


Displaystations:
         m=2 : gosub mousecall
         for x=dbstart to dbstart+19
            locate x+3-dbstart,30
            if x<=dblen then gosub stationline else print space$(48)
         next x
         return


Highlight:
         color 1,11
Unhighlight:
         m=2 : gosub mousecall
         locate dbsel+3-dbstart,30
         x = dbsel
Stationline:
         if dbfrq#(x)>0 then
               print chr$(dbgrp(x)) " " fnfr$(dbfrq#(x));
            else
               for y=1 to 11
                  print chr$(dbgrp(x));
               next y
         end if
         print " " fnmd$(dbmod(x));
         print " " left$(dbinf$(x)+space$(32),32)
         color 10,1
         return


Yesno:
         restore yesnotext : gosub drawdata
         mpos = 0 : reply = 1
         do
            m=1 : gosub mousecall
            select case inkey$
               case "Y","y" : reply = yes
               case "N","n" : reply = no
               case else
                  if mousedriver then
                        m=3 : gosub mousecall
                        if (m2 and 1) then mpos = m4/8*100+m3/8+101
                        select case mpos-pos(0)
                           case 2392 to 2394 : reply = yes
                           case 2398,2399 : reply = no
                           case else
                        end select
                  end if
            end select
         loop while reply=1
         restore clearline : goto displayline

Yesnotext:
   data 1,10,1,-1," ?  ",1,15,4,-1,Yes,1,10,1
   data -1," : ",1,15,4,-1,No,1,10,1,999


Displayline:
         locate 24,1
         goto drawdata

Clearline:
   data 1,10,1,78,32,999


Drawscreen:
         restore fullscreen
         screen 0
Drawdata:
         m=2 : gosub mousecall
         do
            read d
            select case d
               case 999 : return
               case 0 : read c : print : locate ,c
               case 1 : read c,d : color c,d
               case -1 : read i$ : print i$;
               case is <-1 : print chr$(-d);
               case else : read c
                  for x=1 to d
                     print chr$(c);
                  next x
            end select
         loop

Fullscreen:
   data 1,10,1,-12
   data -32,-201,7,205,-181,1,15,4,-1," MODE ",1,10,1,-198,2,205,-32
   data -27,-32,-26,-32,-187,2,32,-201,19,205,-181,1,15,4,-1," STATIONS "
   data 1,10,1,-198,8,205,-32,-24,-32,-25,-1,"  Pgup ",-187,0,1
   data -32,-186,22,32,-186,2,32,-186,50,32,-186,0,1
   data -32,-186,-1,"  LSB  USB  AMN  AM   ",-186,2,32,-186,50,32,-186,0,1
   data -32,-186,-1,"  ASD  ASF  ASL  ASU  ",-186,2,32,-186,50,32,-186,0,1
   data -32,-200,22,205,-188,2,32,-186,50,32,-186,0,1
   data 27,32,-186,50,32,-186,0,1
   data -32,-201,4,205,-181,1,15,4,-1," FREQUENCY ",1,10,1,-198,-205,-32
   data -1,"F1 ",-187,2,32,-186,50,32,-186,0,1
   data -32,-186,22,32,-186,2,32,-186,50,32,-186,0,1
   data -32,-186,-32,1,15,4,-1," < ",1,10,1,-32,1,15,4,-1," - ",1,10,1
   data -1," tune ",1,15,4,-1," + ",1,10,1,-32,1,15,4,-1," > ",1,10,1
   data -32,-186,2,32,-186,50,32,-186,0,1
   data -32,-186,-1,"     ********* kHz    ",-186,2,32,-186,50,32,-186,0,1
   data -32,-200,22,205,-188,2,32,-186,50,32,-186,0,1
   data 27,32,-186,50,32,-186,0,1
   data -32,-201,6,205,-181,1,15,4,-1," MEMORY ",1,10,1,-198,2,205,-32
   data -1,"F2 ",-187,2,32,-186,50,32,-186,0,1
   data -32,-186,22,32,-186,2,32,-186,50,32,-186,0,1
   data -32,-186,-1,"  F3     F4      Mem  ",-186,2,32,-186,50,32,-186,0,1
   data -32,-186,2,32,1,15,4,-1,Store,1,10,1,2,32,1,15,4,-1,Recall
   data 1,10,1,2,32,2,42,3,32,-186,2,32,-186,50,32,-186,0,1
   data -32,-200,22,205,-188,2,32,-186,50,32,-186,0,1
   data 27,32,-186,50,32,-186,0,1
   data -32,-201,5,205,-181,1,15,4,-1," DATABASE ",1,10,1,-198,5,205,-187
   data 2,32,-186,50,32,-186,0,1
   data -32,-186,22,32,-186,2,32,-186,50,32,-186,0,1
   data -32,-186,-1,"  F5  F6   F7   F8    ",-186,2,32,-186,50,32,-186,0,1
   data -32,-186,2,32,1,15,4,-1,Add,1,10,1,-32,1,15,4,-1,Edit,1,10,1,-32
   data 1,15,4,-1,File,1,10,1,-32,1,15,4,-1,Setup,1,10,1,-32,-186
   data 2,32,-186,50,32,-186,0,1
   data -32,-200,22,205,-188,2,32,-200,44,205,-1," Pgdn ",-188
   data 1,14,0,999