rem Copyright 1994, Juergen Weigert and Rudolf Koenig rem Distribute freely and credit us, make profit and share with us. rem email to jnweiger@immd4.informatik.uni-erlangen.de rem Version 0.9 proc main: global s7id%(2),s7ws%(2),s7hs%(2),s7ds%(10) global s7s%(6) local frchd%, mode%, inter%, compl&, r% s7init:(60, 140, 13) r% = ioopen(frchd%, "FRC:", -1) if r% : raise r% : endif mode% = 1 : inter% = 1024 iow(frchd%, 15, mode%, inter%) gat 0, 15 while 1 s7number:(int(hour * 100 + minute) * 100 + second, 6, 2, 4) iow(frchd%, 1, compl&, compl&) endwh endp proc s7number:(n&, nr%, col%, col2%) local ox%, oy%, x%, i%, j&, l%, jj% j& = n& : l% = s7ws%(2) ox% = gx : oy% = gy x% = ox% + (s7ws%(1) + l%) * (nr% - 1) if col% x% = x% + 2 * l% endif if col2% x% = x% + 2 * l% endif while i% < nr% gat x%, oy% jj% = j& - j& / 10 * 10 s7digit:(i%+1, jj%) i% = i% + 1 j& = j& / 10 if col% = i% or col2% = i% x% = x% - 2 * l% gat x%, oy% + 2 * s7hs%(2) / 3 - l%/2 : gfill l%, l%, 0 gat x%, oy% + s7hs%(2) + l%/2 : gfill l%, l%, 0 endif x% = x% - s7ws%(1) - l% endwh gat ox%, oy% endp proc s7digit:(idx%, n%) local i%, j% if s7ds%(n%+1) = s7s%(idx%) return endif i% = 1 : j% = 1 while j% < 8 if (s7ds%(n%+1) AND i%) <> (s7s%(idx%) AND i%) s7seg:(j%) endif i% = i% * 2 j% = j% + 1 endwh s7s%(idx%) = s7ds%(n%+1) endp PROC s7seg:(n%) local x%, y%, i% x%=gx y%=gy if n%=2 or n%=4 gat x%+s7ws%(1)-s7ws%(2), gy endif if n%=3 or n%=4 or n%=6 or n%=7 gat gx, y%+s7hs%(2)-s7hs%(1) endif if n%=7 gat gx, gy+s7hs%(2)-s7hs%(1) endif i%=2 if n%>4 i%=1 endif gcopy s7id%(i%), 0,0, s7ws%(i%), s7hs%(i%),2 gat x%, y% ENDP proc s7init:(w%,hh%,i%) local d%,x%,h%,oldid%,j% oldid%=gidentity d%=i%/2 h%=hh%/2 s7id%(1)=gcreatebit(w%,i%) :gcls s7ws%(1)=w% : s7hs%(1)=i% j%=i%/2 while j%>=0 gat i%-j%,j% :glineto i%-j%, i%-j% gat w%-i%+j%-1,j% :glineto w%-i%+j%-1, i%-j% j%=j%-1 endwh gat i%,0 :gfill w%-i%-i%,i%,0 s7id%(2)=gcreatebit(i%,h%) :gcls s7ws%(2)=i% : s7hs%(2)=h% j%=i%/2 while j%>=0 gat j%,i%-j% :glineto i%-j%, i%-j% gat j%,h%-i%+j%-1 :glineto i%-j%,h%-i%+j%-1 j%=j%-1 endwh gat 0,i% :gfill i%,h%-i%-i%,0 guse oldid% rem segment pattern for digits s7ds%(1)=$5f s7ds%(2)=$0a s7ds%(3)=$76 s7ds%(4)=$7a s7ds%(5)=$2b s7ds%(6)=$79 s7ds%(7)=$7d s7ds%(8)=$1a s7ds%(9)=$7f s7ds%(10)=$7b endp