|
мы с вами (попами) уже это обсуждали \\\ и я и маркаб считаем что все это Фигня --- гороскопы там ... равно денствия и пр
include 'fgraph.fi'
include 'vt125a.for'
program aaaa
include 'fgraph.fd'
integer NARROW, WIDE
parameter (NARROW = 3)
parameter (WIDE = 4)
character*1 asc
integer*2 isc
integer*2 year, month, day
character WideTitle*27 /'‚®б Џ® ‚в® ‘ॠ—Ґв Џпв ‘гЎ'/
character NarrowTitle*20 /'‚б Џ® ‚в ‘а —в Џп ‘г'/
d call Cls()
call cursoroff()
* get today's date
call getdat( year, month, day )
* draw calendar for this month
call Calendar( month, year, 10, 26, WIDE, WideTitle )
* draw calendar for last month
1 call inkey(isc,asc)
select case(isc)
case(75) !vlevo
month = month - 1
if( month .lt. 1 )then
month = 12
year = year - 1
endif
call Calendar( month, year, 10, 26, wide, wideTitle )
* draw calendar for next month
case(77)
month = month + 1
if( month .gt. 12 )then
month = month - 12
year = year + 1
endif
call Calendar( month, year, 10, 26, wide, wideTitle )
case default
if((asc.eq.char(8)).or.(asc.eq.char(12)).or.
*(asc.eq.char(27)))goto 444
end select
goto 1
444 call posit1( 20,1 )
d call inkey(1,' ')
end
subroutine Calendar( month, year, row, col, width, title )
integer*2 month, year
integer row, col, width, nrow
character*(*) title
integer lentrim
integer start, days, box_width, i
character*9 str
character*9 MonthName( 1:12 )
& / 'џў ам', '”Ґўа «м', 'M ав', 'AЇаҐ«м',
& 'Ma©', '€ом', '€о«м', 'AўЈгбв',
& '‘ҐвпЎам', 'OЄвпЎам', 'Ќ®пЎам', '„ҐЄ Ўам' /
integer Jump( 1:12 ) / 1, 4, 4, 0, 2, 5, 0, 3, 6, 1, 4, 6 /
integer FEBRUARY
parameter (FEBRUARY = 2)
integer MonthDays( 1:12 )
& / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
box_width = 7 * width - 1
call Box( row, col, box_width, 8 )
str=' '
str = MonthName( month )
d do lentrim=9,1,-1
d if(str(lentrim:lentrim).ne.' ')exit
d enddo
lentrim=9
call Posit1( row - 1,
& col + 1 + ( box_width - lentrim - 5 ) / 2 )
print '(A,1X,I4,\)', str(1:lentrim), year
call Posit1( row + 1, col + 1 )
print *, title
start = (year - 1900) + (year - 1900) / 4 + Jump( month )
if( ( mod( year, 4 ) .eq. 0 ) .and. ( month .le. FEBRUARY ) )then
start = start - 1
endif
start = mod( start, 7 ) + 1
if( ( mod( year, 4 ) .eq. 0 ) .and. ( month .eq. FEBRUARY ) )then
days = 29
else
days = MonthDays( month )
endif
nrow = row + 3
do i = 1, days
call Posit1( nrow, col + width * start - 2 )
print '(I2),\', i
if( start .eq. 7 )then
nrow = nrow + 1
start = 1
else
start = start + 1
endif
enddo
end
subroutine Box( row, col, width, height )
integer row, col, width, height, i
call Line( row, col-1, width+1, 'Ъ', 'Д', 'ї' )
call Line( row + 1, col-1, width+1, 'і', ' ', 'і' )
call Line( row + 2, col-1, width+1, 'Г', 'Д', 'ґ' )
do i = 3, height
call Line( row + i, col-1, width+1, 'і', ' ', 'і' )
enddo
call Line( row + height + 1, col-1, width+1, 'А', 'Д', 'Щ' )
end
subroutine Line( row, col, width, left, centre, right )
integer row, col, width, i
character left, centre, right
character buffer(  9 )
buffer( 0 ) = left
do i = 1, width
buffer( i ) = centre
enddo
buffer( width + 1 ) = right
call Posit1( row, col )
print *, (buffer( i ), i = 0, width + 1)
end
subroutine Posit1( row, col )
integer row,col
call posit(23,23)
write(*,'(a1,\)')' '
d write(*,'(2i6,\)')row,col
call posit(row,col)
d call inkey(1,' ')
end
|
