program calc c c This program mimics a typical calculator by using the VT100 c auxilary keypad for input and drawing a picture of the calculator c using VT100 graphics - AVO is not necessary - only used to display c display in bold. c c external len, calpic, print integer len, calpic, print integer ndigs integer line(10), col(10), akey, ikey integer iline, icol, n1or2 real*8 f(2), mem byte num(12,2), memory(12), memsgn byte comflg, errmsg, decflg, minflg(2), memflg, funct byte clrscr(7), altkof(3), boldon(5), boldof(4), revon(5), wide(4) byte botlin(16), clreol(5), clrbol(5) data clrscr / "33, '[', 'H', "33, '[', 'J', 0 / data altkof / "33, '>', 0 / data boldon / "33, '[', '1', 'm', 0 / data boldof / "33, '[', 'm', 0 / data revon / "33, '[', '7', 'm', 0 / data wide / "33, '#', '6', 0 / data botlin / 15*' ', 0 / data clreol / "33, '[', '0', 'K', 0 / data clrbol / "33, '[', '1', 'K', 0 / data line /21, 17, 17, 17, 13, 13, 13, 9, 9, 9/ data col /43, 39, 46, 53, 39, 46, 53, 39, 46, 53/ common /errcom/ errmsg, clrscr call ttatt( i ) ! attach TI and allow ESCSEQ if ( i.eq.-1 ) then c can't use call error - don't know if even VT100 call print( '?CALC-F-GTS not SYSGENED' ) call exit else if ( i.eq.-2 ) then call print( '?CALC-F-SF.SMC/SF.GMC not SYSGENED' ) call exit else if ( i.eq.-3 ) then call print( '?CALC-F-TI: is not VT100 type terminal' ) call exit else if ( i.eq.-4 ) then call print( '?CALC-F-Unknown error' ) call exit end if call errset( 73,,,, .FALSE. ) ! trap floating 0 divides c prepare day and date for bottom line call gdate( i ) ! get date in RT-11 internal format (sorry) call idadow( i, botlin(2) ) ! get day of week eg Wednesday botlin(5) = ' ' ! 4th char of day => space call idadmy( i, id, im, iy ) ! get day, month and year no if ( id.ge.10 ) then call idadas( i, botlin(6) ) ! and date in short format eg 27-Jan-85 else botlin(6) = ' ' ! leading space if day <10 call idadas( i, botlin(7) ) ! and date in short format eg 1-Jan-85 end if botlin(15) = ' ' ! 15th char(0) => space c init comflg = .FALSE. n1or2 = 1 ! 1st or 2nd number ndigs = 0 ! position in display counter iline = 1 icol = 1 funct = 0 call print( calpic ) ! draw calculator, enter alternate c keypad mode and put cursor at 1,1 call print( revon(1) ) ! and print bottom line call vprint( 24, 18, wide(1) ) ! in wide mode call print( botlin(1) ) call print( boldof(1) ) call init( 2, num(1,1) ) ! init both numeric displays 100 call vprint( iline, icol, 0 ) ! put cursor at correct pos c WHY IS IT SO ?? said the wise Professor call vprint( iline, icol, 0 ) ! MUST do it twice to work ??? c 0 =key0, 1=key1 etc call keypad( ikey ) ! returns 0=>17 or -1 for ^Z if ( ikey.lt. 0 ) goto 9999 ! exit if ( errmsg ) then ! clear err message call vprint( 12, 32, clrbol(1) ) errmsg = .FALSE. end if c now process command goto ( 1400, 1400, 1400, 1400, 1400, 1400, 1400, 1400, 1400, 1400, 1 3100, 3200, 3300, 3400, 1100, 1000, 3500, 1200 ) ikey + 1 c l = comma + and MSV 1000 if ( comflg ) then comflg = .FALSE. memflg = .TRUE. ! flag displayed c save whatever is last displayed no in memory if ( ndigs.eq.0 ) then ! save 1st number call scopy( num(1,1), memory(1) ) ! as string call cvtaf( memory, mem ) ! and float memsgn = minflg(1) ! and sign else call scopy( num(1,n1or2), memory(1) ) ! as string call cvtaf( memory(1), mem ) ! and float memsgn = minflg(n1or2) ! and sign end if call vprint( 11, 70, 'Memory' ) ! heading call print( revon(1) ) ! display it in memory area if ( memsgn ) then call vprint( 12, 68, '-' ) ! and sign else call vprint( 12, 68, ' ' ) endif call vprint( 12, 69, memory(1) ) ! and number call print( boldof(1) ) ! revof is same as boldof iline = 14 ! MSV at 14, 60 icol = 60 else call cvtaf( num(1,n1or2), f(n1or2) ) ! convert number if ( ndigs.ne.0 .and. n1or2.eq.2 ) then call enter( funct, num(1,1), f(1), minflg(1), boldon, boldof ) funct = '=' ! save function minflg(2) = .FALSE. ! clear sign flag end if funct = '+' ! save function ndigs = 0 ! MSV = terminator.... num(12,n1or2) = 0 ! null terminate 1st no n1or2 = 2 ! switch to 2nd number iline = 13 ! + at 13, 60 icol = 60 endif goto 100 c m = minus - and MRC 1100 if ( comflg ) then comflg = .FALSE. call scopy( memory(1), num(1,n1or2) ) f(n1or2) = mem minflg(n1or2) = memsgn iline = 10 ! MRC at 10, 60 icol = 60 call disply( boldon, memsgn, num(1,n1or2), boldof ) else call cvtaf( num(1,n1or2), f(n1or2) ) ! convert number if ( ndigs.eq.0 .and. n1or2.eq.1) then ! 1st digit and 1st no minflg(1) = .TRUE. ! then sign change goto 1110 else if ( ndigs.ne.0 .and. n1or2.eq.2 ) then call enter( funct, num(1,1), f(1), minflg(1), boldon, boldof ) minflg(2) = .FALSE. ! clear sign flag funct = '=' ! save function end if funct = '-' ! save function ndigs = 0 num(12,n1or2) = 0 ! null terminate 1st no n1or2 = 2 ! switch to 2nd number 1110 iline = 9 ! - at 9, 60 icol = 60 endif goto 100 c n = decimal point 1200 if ( decflg .and. ndigs.ne.0 ) then ! ignore if already on goto 100 else decflg = .TRUE. end if c 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 1400 ndigs = ndigs + 1 if ( ndigs .eq. 1 ) then ! if 1st digit, ini array call init( 1, num(1,n1or2) ) ! init display array if ( ikey.ne.17 ) decflg = .FALSE. ! init DEC flag end if maxdig = 9 if ( decflg ) maxdig = maxdig + 1 if ( ndigs .gt. maxdig ) then ! error too many digits call error( '?CALC-', 'W', '-Too many digits' )! errmsg = .TRUE. goto 100 end if akey = ikey + "60 ! convert to ASCII iline = line(ikey+1) ! altered if . icol = col (ikey+1) ! altered if . if ( decflg .and. ikey.eq.17 ) then ! just got decimal point iline = 21 icol = 53 if ( ndigs .eq. 1 ) num( 9, n1or2 ) = ' '! clear initial 0 from display else if ( decflg ) then do 1420 i = ndigs, 1, -1 ! move em <= 1420 num(11-i,n1or2) = num(12-i,n1or2) num( 10, n1or2 ) = akey else do 1430 i = ndigs, 1, -1 ! move em <= 1430 num(10-i,n1or2) = num(11-i,n1or2) num( 9, n1or2 ) = akey end if call disply( boldon, minflg(n1or2), num(1,n1or2), boldof ) comflg = .FALSE. goto 100 c PF1 - GOLD and REF 3100 if ( comflg ) then comflg = .FALSE. call print( calpic ) call print( revon(1) ) ! and print bottom line call vprint( 24, 18, wide(1) ) ! in wide mode call print( botlin(1) ) call print( boldof(1) ) if ( funct.ne.'=' ) then call disply( boldon, minflg(n1or2), num(1,n1or2), boldof ) else call disply( boldon, minflg(1), num(1,1), boldof ) end if if ( memflg ) then call vprint( 11, 70, 0 ) ! heading call vprint( 11, 70, 0 ) ! heading call print( 'Memory' ) ! heading call print( revon(1) ) ! display it in memory area if ( memsgn ) then call vprint( 12, 68, '-' ) ! and sign else call vprint( 12, 68, ' ' ) endif call vprint( 12, 69, memory(1) ) ! and number call print( boldof(1) ) ! revof is same as boldof end if iline = 6 icol = 39 else comflg = .TRUE. ! set command flag iline = 5 icol = 39 end if goto 100 c PF2 - % and CLM 3200 if ( comflg ) then comflg = .FALSE. ! GOLD % is nothing (at moment) memflg = .FALSE. ! clear memory flag call vprint( 11, 70, clreol(1) ) ! clear eol call vprint( 12, 68, clreol(1) ) ! clear eol mem = 0. ! clear mem float memsgn = .false. ! clear mem sign call init( 1, memory(1) ) ! clear mem digits iline = 6 icol = 46 else c doing 1st number, just display number as % if ( n1or2 .eq. 1 ) then call cvtaf( num(1,1), f(1) ) f(2) = 100. call enter( '/', num(1,1), f(1), minflg(1), boldon, boldof ) funct = '=' ndigs = 0 ! treat as end of number else c doing 2nd number, take 2nd number as % of 1st number call cvtaf( num(1,2), f(2) ) f(2) = f(2) * f(1) / 100. call cvtfa( f(2), num(1,2) ) ! => ASCII c and set sign flag appropriately if ( minflg(1) ) then minflg(2) = .TRUE. else minflg(2) = .FALSE. ! clear sign flag end if c and display the % number call disply( boldon, minflg(2), num(1,n1or2), boldof ) end if iline = 5 icol = 46 end if goto 100 c PF3 - / and CLE 3300 if ( comflg ) then comflg = .FALSE. call init( 1, num(1,n1or2) ) minflg(n1or2) = .FALSE. call disply( boldon, minflg(n1or2), num(1,n1or2), boldof ) iline = 6 ! CLE at 6, 53 icol = 53 else call cvtaf( num(1,n1or2), f(n1or2) ) ! convert number if ( ndigs.ne.0 .and. n1or2.eq.2 ) then call enter( funct, num(1,1), f(1), minflg(1), boldon, boldof ) minflg(2) = .FALSE. ! clear sign flag funct = '=' ! save function end if funct = '/' ! save function num(12,n1or2) = 0 ! null terminate 1st no n1or2 = 2 ! switch to 2nd number iline = 5 ! / at 5, 53 icol = 53 endif ndigs = 0 goto 100 c PF4 - x and CLA 3400 if ( comflg ) then comflg = .FALSE. call init( 2, num(1,1) ) minflg(1) = .FALSE. minflg(2) = .FALSE. call disply( boldon, minflg(n1or2), num(1,n1or2), boldof ) iline = 6 ! CLA at 6,60 icol = 60 n1or2 = 1 ! switch to 1st number else call cvtaf( num(1,n1or2), f(n1or2) ) ! convert number if ( ndigs.ne.0 .and. n1or2.eq.2 ) then call enter( funct, num(1,1), f(1), minflg(1), boldon, boldof ) minflg(2) = .FALSE. ! clear sign flag funct = '=' ! save function end if funct = '*' ! save function num(12,n1or2) = 0 ! null terminate 1st no n1or2 = 2 ! switch to 2nd number iline = 5 ! * at 5,60 icol = 60 endif ndigs = 0 ! reset digit count goto 100 c ENTER - = and OFF 3500 if ( comflg ) then goto 9999 ! off else call cvtaf( num(1,n1or2), f(n1or2) ) ! convert 2nd number if ( n1or2.eq.2 ) then call enter( funct, num(1,1), f(1), minflg(1), boldon, boldof ) end if end if minflg(2) = .FALSE. ! clear sign flag ndigs = 0 funct = '=' ! set funct flag iline = 17 icol = 60 goto 100 9999 call vprint( 1, 1, clrscr(1) ) ! clr screen call ttdet( i ) ! detach terminal call print( altkof(1) ) ! alternate keypad off call exit end subroutine init( iflag, array ) byte array(12,2), string(12) integer iflag data string/ 8*' ', '0', '.', ' ', 0 / if ( iflag.eq.1 ) then call scopy( string(1), array(1,1) ) else call scopy( string(1), array(1,1) ) call scopy( string(1), array(1,2) ) end if return end subroutine enter( funct, num, f, minflg, boldon, boldof ) c performs operation defined in funct c and displays result after putting answer in num(1,1) c real*8 f(2), temp logical*1 funct, num(12,2), boldon(1), boldof(1), minflg(2) if ( minflg(1) ) f(1) = -f(1) ! correct signs if ( minflg(2) ) f(2) = -f(2) ! before doing operation c execute appropriate function if ( funct.eq.'+' ) then temp = f(1) + f(2) else if ( funct.eq.'-' ) then temp = f(1) - f(2) else if ( funct.eq.'*' ) then temp = f(1) * f(2) else if ( funct.eq.'/' ) then temp = f(1) / f(2) end if if ( minflg(2) ) f(2) = -f(2) ! and recorrect f(2) f(1) = dabs(temp) if ( temp .lt. 0. ) then minflg(1) = .TRUE. else minflg(1) = .FALSE. end if call cvtfa( f(1), num(1,1) ) call disply( boldon, minflg(1), num(1,1), boldof ) return end subroutine disply( boldon, minflg, num, boldof ) c displays numbers in display area of calculator byte boldon(1), boldof(1), minflg(1), num(12,1) call vprint( 2, 20, boldon(1) ) if ( minflg(1) ) then call vprint( 2, 20, '-' ) call vprint( 3, 20, '-' ) else call vprint( 2, 20, ' ' ) call vprint( 3, 20, ' ' ) end if call vprint( 2, 21, num(1, 1) ) call vprint( 3, 21, num(1, 1) ) call print( boldof(1) ) return end subroutine error( text0, level, text1 ) c c error processing subroutine c external len byte level(1), text0(1), text1(1), string(80), errmsg, clrscr(7), bell data bell/ "7 / common /errcom/ errmsg, clrscr if ( level(1) .eq. 'F' ) then call print( clrscr(1) ) ! clear screen end if string(1) = bell call scopy( text0(1), string(2) ) ! copy text0 i = len( string(1) ) call scopy( level(1), string(i+1) ) ! copy level i = len( string(1) ) call scopy( text1, string(i+1) ) ! copy text1 if ( level(1) .eq. 'F' ) then call vprint( 1, 1, string(1) ) ! print message at 1,1 if fatal call exit else call vprint( 12, 1, string(1) ) ! print message at 12,1 if not errmsg = .TRUE. ! indicate message displayed return end if end