home *** CD-ROM | disk | FTP | other *** search
/ Computerworld 1996 April / Computerworld_1996-04_cd.bin / cw / programy / psion / cas / s7.opl < prev    next >
Encoding:
Text File  |  1996-07-20  |  2.5 KB  |  136 lines
  1. rem Copyright 1994, Juergen Weigert and Rudolf Koenig
  2. rem Distribute freely and credit us, make profit and share with us.
  3. rem email to jnweiger@immd4.informatik.uni-erlangen.de
  4. rem Version 0.9
  5.  
  6. proc main:
  7.     global s7id%(2),s7ws%(2),s7hs%(2),s7ds%(10)
  8.     global s7s%(6)
  9.     
  10.     local frchd%, mode%, inter%, compl&, r%
  11.     
  12.     s7init:(60, 140, 13)
  13.     
  14.     r% = ioopen(frchd%, "FRC:", -1)
  15.     if r% : raise r% : endif
  16.     mode% = 1 : inter% = 1024
  17.     iow(frchd%, 15, mode%, inter%)
  18.  
  19.     gat 0, 15
  20.     while 1
  21.         s7number:(int(hour * 100 + minute) * 100 + second, 6, 2, 4)
  22.         iow(frchd%, 1, compl&, compl&)
  23.     endwh
  24. endp
  25.  
  26. proc s7number:(n&, nr%, col%, col2%)
  27.   local ox%, oy%, x%, i%, j&, l%, jj%
  28.   
  29.   j& = n& : l% = s7ws%(2)
  30.   ox% = gx : oy% = gy
  31.   x% = ox% + (s7ws%(1) + l%) * (nr% - 1)
  32.   if col%
  33.       x% = x% + 2 * l%
  34.   endif
  35.   if col2%
  36.       x% = x% + 2 * l%
  37.   endif
  38.   
  39.   while i% < nr%
  40.       gat x%, oy%
  41.       jj% = j& - j& / 10 * 10
  42.       s7digit:(i%+1, jj%)
  43.       i% = i% + 1
  44.       j& = j& / 10
  45.       if col% = i% or col2% = i%
  46.           x% = x% - 2 * l%
  47.           gat x%, oy% + 2 * s7hs%(2) / 3 - l%/2 : gfill l%, l%, 0
  48.           gat x%, oy% +     s7hs%(2)     + l%/2 : gfill l%, l%, 0
  49.       endif
  50.       x% = x% - s7ws%(1) - l%
  51.   endwh
  52.   gat ox%, oy%
  53. endp
  54.  
  55. proc s7digit:(idx%, n%)
  56.     local i%, j%
  57.     
  58.     if s7ds%(n%+1) = s7s%(idx%)
  59.         return
  60.     endif
  61.     
  62.     i% = 1 : j% = 1
  63.     while j% < 8
  64.         if (s7ds%(n%+1) AND i%) <> (s7s%(idx%) AND i%)
  65.             s7seg:(j%)
  66.         endif
  67.         i% = i% * 2
  68.         j% = j% + 1
  69.     endwh
  70.     s7s%(idx%) = s7ds%(n%+1)
  71. endp
  72.  
  73. PROC s7seg:(n%)
  74.     local x%, y%, i%
  75.  
  76.     x%=gx
  77.     y%=gy
  78.     if n%=2 or n%=4
  79.         gat x%+s7ws%(1)-s7ws%(2), gy
  80.     endif
  81.     if n%=3 or n%=4 or n%=6 or n%=7
  82.         gat gx, y%+s7hs%(2)-s7hs%(1)
  83.     endif
  84.     if n%=7
  85.         gat gx, gy+s7hs%(2)-s7hs%(1)
  86.     endif
  87.     i%=2
  88.     if n%>4
  89.         i%=1
  90.     endif
  91.     gcopy s7id%(i%), 0,0, s7ws%(i%), s7hs%(i%),2
  92.     gat x%, y%
  93. ENDP
  94.  
  95. proc s7init:(w%,hh%,i%)
  96.     local d%,x%,h%,oldid%,j%
  97.  
  98.     oldid%=gidentity
  99.     d%=i%/2
  100.     h%=hh%/2
  101.     
  102.     s7id%(1)=gcreatebit(w%,i%) :gcls
  103.     s7ws%(1)=w% : s7hs%(1)=i%
  104.     j%=i%/2
  105.     while j%>=0
  106.         gat i%-j%,j% :glineto i%-j%, i%-j%
  107.         gat w%-i%+j%-1,j% :glineto w%-i%+j%-1, i%-j%
  108.         j%=j%-1
  109.     endwh
  110.     gat i%,0 :gfill w%-i%-i%,i%,0
  111.     
  112.     s7id%(2)=gcreatebit(i%,h%) :gcls
  113.     s7ws%(2)=i% : s7hs%(2)=h%
  114.     j%=i%/2
  115.     while j%>=0
  116.         gat j%,i%-j% :glineto i%-j%, i%-j%
  117.         gat j%,h%-i%+j%-1 :glineto i%-j%,h%-i%+j%-1
  118.         j%=j%-1
  119.     endwh
  120.     gat 0,i% :gfill i%,h%-i%-i%,0
  121.     
  122.     guse oldid%
  123.  
  124. rem segment pattern for digits
  125.     s7ds%(1)=$5f
  126.     s7ds%(2)=$0a
  127.     s7ds%(3)=$76
  128.     s7ds%(4)=$7a
  129.     s7ds%(5)=$2b
  130.     s7ds%(6)=$79
  131.     s7ds%(7)=$7d
  132.     s7ds%(8)=$1a
  133.     s7ds%(9)=$7f
  134.     s7ds%(10)=$7b
  135. endp
  136.