home *** CD-ROM | disk | FTP | other *** search
- rem * Phone Book Sorter for
- rem * Psion Series 3
- rem *
- rem * sort a data file by
- rem * its first field. The first
- rem * field is assumed to be a
- rem * string.
- rem *
- rem * Tal Dayan, Dec 92
- rem *
-
- app Sorter
- type 4
- path "\dat"
- ext "dbf"
- icon "\opd\sorter.pic"
- enda
-
-
- proc main:
-
- statuswin on
- rem screen 30, 9, 1, 1
- gsetwin 0, 0, 185, 79
- gborder $200+1
-
- at 3, 2
- print "Sorter v1.00 by Tal Dayan"
-
- if cmd$(3)="C"
- dInit
- dText "", "Only existing files can be sorted", 2
- dButtons "Exit", -27
- dialog
- stop
- endif
-
- open:(cmd$(2))
-
- if sorted%:
- dInit
- dText "", "File already sorted", 2
- dButtons "Exit", -27
- dialog
- else
- at 3,4
- print "["; count; "] entrys"
- sort:
- sound:
- dInit
- dText "", "Sorting done", 2
- dButtons "Exit", -27
- dialog
- endif
- endp
-
-
- rem -- Open and sort the
- rem -- file. This is done
- rem -- by moving the record
- rem -- with smallest name
- rem -- to the end of the
- rem -- file
-
-
- proc sort:
- local n%
-
- n%=count
-
- busy "[Sorting] ", 1
-
- bar:(-1.0)
-
- while n% > 0
- findNext: (n%)
- update
- n% = n% - 1
- bar:(1.0 - flt(n%) / flt(count))
- endwh
-
- Busy off
-
- endp
-
-
- rem -- Ask user for file
- rem -- to sort and open it
- rem -- as logical file A
-
-
- proc open:(fn$)
- local fname$(254)
- local e%
- local ok%
- local ask%
-
- if fn$=""
- ask%=-1
- fname$="\dat\*.dbf"
- else
- ask%=0
- fname$=fn$
- endif
-
- do
- if ask%
- dInit "Data file to sort"
- dFile fname$, "", 16
- if dialog = 0
- stop
- endif
- endif
-
-
- trap open fname$,a,name$
- if err = 0
- ok% = 1
- else
- e%=err
- dInit err$(e%)
- dText "", " ", 0
- dText "", fname$, 0
- dText "", " ", 0
- if ask%
- dButtons "Abort", -27, "Retry", -13
- else
- dButtons "Abort", -27
- endif
- if dialog = 0
- stop
- endif
- ok% = 0
- endif
- until ok%
- endp
-
-
- rem -- Position the file on
- rem -- the smallest record
- rem -- among the records
- rem -- 1..n
-
-
- proc sorted%:
- local ok%
- local sel$(254)
-
- first
- ok% = not 0
-
- sel$=lower$(a.name$)
- while pos < count and ok%
- next
- if (lower$(a.name$) < sel$)
- ok% = 0
- else
- sel$=lower$(a.name$)
- endif
- endwh
- Busy off
- return ok%
- endp
-
-
- rem -- Position the file on
- rem -- the smallest record
- rem -- among the records
- rem -- 1..n
-
- proc findNext: (n%)
- local sel%
- local sel$(254)
- first
- sel%=1
- sel$=lower$(a.name$)
- while pos < n%
- next
- if (lower$(a.name$) < sel$)
- sel%=pos
- sel$=lower$(a.name$)
- endif
- endwh
- position sel%
- endp
-
-
- rem -- wait the user to
- rem -- press Enter, used
- rem -- for debuging only
-
- proc wait:
- local r$(5)
- print " continue...";
- input r$
- endp
-
-
- rem --
- rem -- make sound
- rem --
-
-
- proc sound:
- local i%
- i%=300
- while i% < 1000
- beep 2, i%
- i% = i% + 150
- endwh
- endp
-
-
- proc bar: (cmd)
-
- local x0%, y0%, w0%, h0%
- local x1%, y1%, w1%, h1%
- local s
-
- x0%= 9 : y0%=50
- w0%=164 : h0%=12
-
- x1%=2 : y1%=2
-
- w1%=w0%-5
- h1%=h0%-5
-
- if (cmd < 0)
- gCreate(x0%, y0%, w0%, h0%, 1)
- gBorder 1
- else
- gAt x1%, y1%
- gfill w1%*cmd, h1%, 0
- endif
- endp
-