1 ! this program will print out exercise lines to the CRT, and & ! then check for correct typing 10 external long function sys$trnlog, & sys$assign, & sys$qiow, & sys$qio & \ external integer function sys$getmsg, & scr$erase_page, & lib$put_screen, & scr$put_screen & \ external integer constant io$_setmode, & io$m_nofiltr, & io$m_timed, & io$m_noecho, & ss$_timeout, & io$_readvblk & \ common (errmsg) msg$ = 80% & \ common (terminal_buffer) io_sb%(1%), & term_blk%(1%), buf_fer$= 80% & \ common (bufcom) rsn_buf$ = 80 20 dim lin$(1500) 30 gosub 30000 40 cr$ = chr$(13) 200 bold% = 1% & \ reverse% = 2% & \ blink% = 4% & \ underscore% = 8% 300 open "typist" as file 2%, access read, allow read 400 print "enter teminal type [ HP(1) , DEC(2) , Heath(3) ] ? "; & \ gosub 30400 & \ term = val(edit$(left(buf_fer$,instr(1,buf_fer$,chr$(13%))-1),32)) 410 if term = 2 then rev$ = chr$(27)+"[7m" & \ unrev$ = chr$(27)+"[0m" 420 if term = 1 then rev$ = chr$(27)+"&dA" & \ unrev$ = chr$(27)+"&d@" 430 if term = 3 then rev$ = chr$(27)+"p" & \ unrev$ = chr$(27)+"q" 1000 ! start and format screen 1010 ! open and read exercise file 1100 ! print header 1200 ! inquire for lesson to run 1205 print " several lessons are available: " & \ print " speed drills (s1 - s4) " & \ print " touch typing (t1 - t16)" & \ print " calculator keypad (n1 - n3)" & \ print " " 1210 print " enter the desired lesson name ? "; \ gosub 30400 & \ lesson$ = edit$(left(buf_fer$,instr(1,buf_fer$,chr$(13%))-1),32) 1300 ! find lesson 1305 for i% = 1% to 1500 1310 input line #2%, a$ & \ a$ = edit$(a$,4%) & \ if a$ = "*"+lesson$+"*" then 1312 1311 next i% 1312 on error goto 1322 1320 for totline% = 1% to 1500 & \ input line #2%, lin$(totline%) & \ lin$(totline%) = edit$(lin$(totline%),4%) & \ if left(lin$(totline%),1) = "*" then 1322 1321 next totline% 1322 resume 1335 1335 on error goto 0 1400 oldtyp% = 4% 1415 for lesline% = 1% to totline% 1417 pagestart% = lesline% 1420 t$ = lin$(lesline%) 1422 if left(t$,1) = "*" then 1490 1425 com% = instr(1,t$,"\") 1430 if com%=0% then lesline% = lesline% + 1% & \ goto 1420 1440 com$ = mid(t$,com%+1,1) & \ lin$(lesline%) = left(lin$(lesline%),com%-1%) & \ t$ = lin$(lesline%) & \ pageend% = lesline% & \ if com$ = "" then typ% = oldtyp% \ goto 1460 1450 typ% = instr(1,"BPITD",com$) 1460 oldtyp% = typ% & \ on typ% gosub 2500,2100,2400,2200,2000 1470 next lesline% 1490 goto 31000 2000 ! & ! type out line of lesson, check for correct \D & ! 2005 t$ = lin$(lesline%) 2007 a$ = fnpr$(t$,10,1,0) & \ a$ = fnpr$("",11,1,0) 2015 for testc% = 1% to len(t$) 2020 gosub 30220 & \ if mid(t$,testc%,1%) <> left(buf_fer$,1) then & a$ = fnpr$("X"+chr$(7%),11,testc%,0) & else a$ = fnpr$("",11,1+testc%,0) 2030 next testc% 2040 gosub 30400 & \ dumx$ = seg$(buf_fer$,1,buf_len%) & \ a$ = fnclear$(1,1) 2090 return 2100 ! & ! type out line of lesson, reverse incorrect, for many lines & ! and time \P 2105 for test% = pagestart% to pageend% & \ a$ = fnpr$(lin$(test%),test%+7-pagestart%,1,0) ! print out text ! & \ next test% 2107 starttime = time(0) & \ totalchars = 0 & \ errors = 0 2110 for test% = pagestart% to pageend% 2111 t$ = lin$(test%) & \ totalchars = totalchars + len(t$) \ a$ = fnpr$("",test%+7-pagestart%,1,0) 2115 for testc% = 1% to len(t$) 2120 gosub 30220 & \ if mid(t$,testc%,1%) <> buf_fer$ then & a$ = fnpr$(mid(t$,testc%,1),test%+7-pagestart%,testc%, & 2%) & \ errors = errors + 1 & else a$ = fnpr$("",test%+7-pagestart%,1+testc%,0) 2130 next testc% 2140 gosub 30400 & \ dumx$ = seg$(buf_fer$,1,buf_len%) 2150 next test% 2185 testtime = (time(0) - starttime)/60 & \ words = totalchars/5 & \ speed = words/testtime & \ a$ = fnpr$("typing speed (words per minute) = "+num1$(speed),20,40, & 2%) & \ a$ = fnpr$("with "+num1$(100*errors/totalchars)+" percent errors",21,40,& 2%) & \ gosub 2600 & \ a$ = fnclear$(1,1) 2190 return 2200 ! & ! type out lines of lesson \T & ! 2204 a$ = fnclear$(1,1) 2210 for test% = pagestart% to pageend% 2211 t$ = lin$(test%) 2212 if instr(1,t$,"\T") then & a$ = fnpr$(t$,2%+test%-pagestart%+3%,1,0) & \ goto 2290 2220 a$ = fnpr$(t$,test%+2%-pagestart%,1,0) 2250 next test% 2280 gosub 2600 & \ a$ = fnclear$(1,1) 2290 return 2400 ! clear screen and print instruction line \I 2410 a$ = fnclear$(1,1) & \ a$ = fnpr$(t$,5,1,0) & \ return 2500 ! clear screen \B 2510 a$ = fnclear$(1,1) & \ a$ = fnpr$(t$,2,30,0) & \ gosub 2600 \ return 2600 ! wait til screen read 2610 a$ = fnpr$("hit any key to continue",24,10,2%) & \ gosub 30220 & \ return 20000 def* fnpr$(dum$,hor%,ver%,flag%) & ! function to print a string at a specified row and column 20005 if flag% = 2% then dum$ = rev$+dum$+unrev$ 20010 sys_status% = scr$put_screen(dum$ & ,hor% by value & ,ver% by value & ,flag% by value) 20020 if (sys_status% and 1%) <> 1 then print "fnpr$ error"; & \ gosub 30290 20030 fnend 20100 def* fnclear$(hor%,ver%) & \ sys_status% = scr$erase_page(hor% by value, ver% by value) & \ if (sys_status% and 1%) <> 1 then print "fnclear$ error" & \ gosub 30290 20110 fnend 30000 ! program to obtain single characters from keyboard 30090 ter$ = "TT" 30100 ! 30140 ! INITIALIZE THE CHANNEL AND TRANSLATE LOGICAL NAME 30150 SYS_STATUS% = SYS$TRNLOG(TER$, RSN_LEN%, RSN_BUF$, , , , ) 30160 IF (SYS_STATUS% AND 1%) = 0% THEN PRINT "translate error: "; & SYS_STATUS% & \ GOSUB 30290 30170 EQNAME$ = SEG$(RSN_BUF$, 1%, RSN_LEN%) 30180 SYS_STATUS% = SYS$ASSIGN(EQNAME$, CHAN%, , ) 30190 IF (SYS_STATUS% AND 1%)<>1 THEN PRINT "assign error: "; & SYS_STATUS% & \ GOSUB 30290 30200 RETURN 30210 ! ROUTINE TO ACTUALLY READ THE CHARACTER 30220 BUF_LEN% = 1% ! MAX OF 1 CHARACTER 30230 BUF_FER$="" 30240 TERM_BLK%(0%) = 0% & \ TERM_BLK%(1%) = 0% ! NO TERMINATOR CHARACTERS 30250 SYS_STATUS% = SYS$QIOW(, CHAN% BY VALUE, & IO$_READVBLK+IO$M_NOECHO BY VALUE, & IO$_SB%() BY REF, , , BUF_FER$ BY REF, & BUF_LEN% BY VALUE,, & TERM_BLK%() BY REF, , ) 30260 IF (SYS_STATUS% AND 1%) = 0% THEN PRINT "QIOW ERROR: "; SYS_STATUS% & \ GOSUB 30290 30270 ! PRINT "# OF RECEIVED CHARACTERS =="; INT(IO$_SB%(0%)/2^16) 30280 RETURN 30289 ! ERROR MESSAGE SUBROUTINE 30290 SAVE_STATUS% = SYS_STATUS% 30300 SYS_STATUS% = SYS$GETMSG(SAVE_STATUS% BY VALUE, I% BY REF, MSG$, & 15% BY VALUE, ) 30310 PRINT SEG$(MSG$, 1%, I%) 30315 RETURN 30320 ! PRINT " VALUE READ FROM ANA="; BUF_FER$ 30330 RETURN 30400 ! SUBOUTINE TO READ A CR/LF LINE FROM ANA 30410 BUF_FER$ = "" 30420 BUF_LEN% = 80% 30430 TERM_BLK%(0%) = 0% & \ TERM_BLK%(1%) = 2^10 + 2^13 ! CR-LF TERMINATORS 30440 SYS_STATUS% = SYS$QIOW(, CHAN% BY VALUE, & IO$_READVBLK BY VALUE, & IO$_SB%() BY REF, , , BUF_FER$ BY REF, & BUF_LEN% BY VALUE, & 2% BY VALUE, & TERM_BLK%() BY REF, , ) 30450 IF (SYS_STATUS% AND 1%) = 0% THEN PRINT "qiow error: "; & SYS_STATUS% & \ GOSUB 30290 30465 ! PRINT "RECEIVED ="; BUF_FER$; " LENGTH="; BUF_LEN% 30470 RETURN 31000 close i% for i% = 1% to 12% 32767 END