10! OUTPUT 2 USING "#,K";"<lf>REN<cr>INDENT<cr><lf>RE-STORE ""USER""<cr>"
20 !
30 ! EDIT Test_prog
40 ! EDIT User_user
50 ! EDIT User_spread
60 ! EDIT User_clr_scr
70 ! EDIT User_log_key
80 ! EDIT User_keylabel
90 ! EDIT User_error
100 ! EDIT User_stop
110 ! EDIT User_yes
120 !
130 User_doc: !
140 ! *****************************************************************
150 ! USER INTERFACE (User_) FILE DESCRIPTION
160 ! Subprograms in the USER file are used to
170 ! interface to the user. The two main functions are a spread sheet
180 ! and softkey handling.
190 !------------------------------------------------------------------
200 !
210 ! Softkey scheme:
220 ! In the HP3565 Demo programs, softkeys are used to for program
230 ! control but the ON KEY statements do not directly call the appropriate
240 ! subprogram. Rather, each ON KEY statement calls a subprogram
250 ! (like User_key1isr) that logs the key and then exits. The main program
260 ! can then "read" the softkey using FNUser_get_key and call the
270 ! appropriate subprogram. Lower-level subprograms can use FNUser_key_press
280 ! to check if a softkey is pending and exit. This scheme allows the
290 ! softkeys to work like the hardkeys on a traditional instrument, avoids
300 ! priority problems, and allows parameters to be passed to subprograms
310 ! called by sofkteys.
320 !------------------------------------------------------------------
330 Test_prog: !
340 ! <PLACE TEST CODE HERE>
350 ! LOADSUB ALL FROM "LIB"
360 CALL User_user
370 !This subprogram demonstrates how the use SUB Spread_sheet
380 !
390 COM /Spread_demo/ Row,Col,Start_row !keep these in com for memory
400 DIM New_entry$[160]
410 Max_col=4
420 Max_row=10
430 Start_row=0
440 ALLOCATE Box$(1:Max_col,1:Max_row)[20]
450 ALLOCATE Title$(1:Max_col,0:2)[20]
460 ALLOCATE Cmd$(1:Max_col)[10]
470 ALLOCATE Prompt$(1:Max_col)[80]
480 ALLOCATE Col_width(1:Max_col)
490 !
500 ! These data statements define the setup and titles for each column
510 !
520 ! col_width title1 title2 Cmd Prompt
530 ! --------- ---------- ---------- --- --------------------
540 DATA 36, "Channel", "Name", "", ""
550 DATA 4, "Mode", "", "INPM", "Input mode: Volt, ICP, or Chrg"
560 DATA 10, "Range", "(dB)", "RNG", "Full scale Range in dBVp or dBpCp"
570 DATA 10, "Center Freq", "(Hz)", "CF", "Center frequency in Hz"580 !
590 Modify_col=4 !col 2 an up will be modifiable
600 !
610 !read the above data into arrays
620 Title$(1,0)="Main title"
630 FOR C=1 TO Max_col
640 READ Col_width(C),Title$(C,1),Title$(C,2),Cmd$(C),Prompt$(C)
650 NEXT C
660 !
670 !define softkeys. Keys 1 to 4 are reserved for "hardkeys"
680 ON KEY 5 LABEL " Reset" CALL User_key5isr
690 ON KEY 6 LABEL "Autorange" CALL User_key6isr
700 ON KEY 7 LABEL " Etc" CALL User_key7isr
710 !
720 !fill Box$ array with initial dummy data
730 Box$(1,1)="All inputs"
740 FOR R=2 TO Max_row
750 Box$(1,R)="Ch "&VAL$(R)&" @ 0,"&VAL$(R)
760 Box$(2,R)="Volt"
770 IF R>10 THEN Box$(2,R)="Chg"
780 Box$(3,R)=VAL$(-R*2)
790 Box$(4,R)=VAL$(1024.25*R)
800 NEXT R
810 !
820 !
830 CALL User_clr_scr
840 !Now call spread sheet. It returns with New_entry$ and Row and Col
850 Done=0
860 REPEAT
870 CALL User_spread(Box$(*),Title$(*),Prompt$(*),New_entry$,Col_width(*),Modify_col,Col,Row,Start_row)
880 SELECT FNUser_check_key
890 CASE 0 !no key pressed, must be a New_entry$ for Box
900 GOSUB New_entry
910 CASE 5
920 Dummy=FNUser_get_key !to clear the key
930 DISP "Reset-ing"
940 CASE 6
950 Dummy=FNUser_get_key
960 DISP "Autoranging"
970 CASE 7
980 Dummy=FNUser_get_key
990 DISP "Etc ing"
1000 CASE ELSE !a softkey but not one of mine, so exit
1010 Done=1
1020 END SELECT
1030 UNTIL Done
1040 CALL User_clr_scr
1050 ! SUBEXIT
1060 STOP
1070 New_entry: !------------------------------------------------
1080 !acts on new_entry from spread_sheet
1090 IF TRIM$(New_entry$)<>"" THEN
1100 IF Row=1 THEN
1110 DISP "sending global command ";Cmd$(Col);" ";New_entry$
1120 FOR R=2 TO Max_row
1130 Box$(Col,R)=New_entry$
1140 NEXT R
1150 ELSE !not global command
1160 DISP "sending ";Cmd$(Col);" ";New_entry$
1170 Box$(Col,Row)=New_entry$
1180 END IF
1190 DISP
1200 END IF
1210 RETURN
1220 !
1230 !
1240 END
1250 ! PAGE ->
1260 !************************************************************************
1270 User_user:SUB User_user
1280 !This subprogram defines and initializes all common blocks used by
1290 !subprograms in the USER file.
1300 COM /User_key/ INTEGER Key_no,None
1310 INTEGER Stat
1320 None=-99
1330 Key_no=None
1340 STATUS KBD,9;Stat !get KBD type
1350 IF BIT(Stat,5) THEN !its a HP46020
1360 CONTROL KBD,14;0 !map f0 to key 0
1370 CONTROL KBD,2;1 !user menu 1
1380 END IF
1390 SUBEND
1400 !************************************************************************
1410 User_spread:SUB User_spread(Box$(*),Title$(*),Prompt$(*),New_entry$,Col_width(*),Modify_col,Col,Row,Start_row)
1420 ! This subprogram allows the user move a highlighted box around
1430 ! a table of data similar to a spread sheet. It exits 2 different
1440 ! ways: 1) when the user completes a new entry for a box. The new
1450 ! entry is not put in the box, it is returned in New_entry$
1460 ! 2) When the function FNUser_key_press is becomes true.
1470 !
1480 ! INPUTS: Box$(1:max_col,1:max_row) : array of boxes
1490 ! Title$(1:max_col,0:2) :array of column titles, two lines each
1500 ! Title$(1,0) is the main title.
1510 ! Title$(*,1..2) are col titles.
1520 ! Prompt$(1:max_col) :array of prompts for each column.
1530 ! If there is only one modifiable column,
1540 ! then prompts are for rows.
1550 ! Col_width(1:max_col) :column sizes in displayed characters.
1560 ! Modify_col :first column that can be modified, 1=all.
1570 ! OUTPUTS:New_entry$ :new entry if keyboard entry.
1580 ! IN&OUT: Col, Row :location of highlighted box.
1590 ! Start_row :top row of display.
1600 !
1610 !Before calling this the screen should be cleared.
1620 INTEGER Knob_trigger,Knobx_counter,Knoby_counter,C,R,Max_col,Max_row
1630 INTEGER Lines_per_page,Old_row,Pri,Stat,Itf_kbd,Prompt_by_col
1640 DIM My_kbd$[255],Iv$[1],Ul$[1],Iv_ul$[1],De_off$[1],White$[1],Yellow$[1],Cyan$[1],Green$[1]
1650 De_off$=CHR$(128) !display enhancements off
1660 Iv$=CHR$(129) !inverse video
1670 Ul$=CHR$(132) !underline
1680 Iv_ul$=CHR$(133) !both
1690 White$=CHR$(136)
1700 Green$=CHR$(139)
1710 Cyan$=CHR$(140)
1720 Yellow$=CHR$(138)
1730 Pri=VAL(SYSTEM$("SYSTEM PRIORITY"))+1
1740 DISABLE
1750 Lines_per_page=FNLib_crt_height-7-3 !-7 for system, -3 for titles
1760 STATUS KBD,9;Itf_kbd !get KBD type
1770 Itf_kbd=BIT(Itf_kbd,5)
1780 IF Itf_kbd THEN !its a HP46020
1790 Knob_trigger=30
1800 STATUS KBD,2;Stat
1810 IF Stat<>1 THEN CONTROL KBD,2;1 !user menu 1
1820 ELSE !assume knob
1830 Knob_trigger=12
1840 END IF
1850 Max_col=SIZE(Box$,1)
1860 Max_row=SIZE(Box$,2)
1870 Col=MAX(Modify_col,MIN(Max_col,Col))
1880 Row=MAX(1,MIN(Max_row,Row))
1890 IF (Modify_col=Max_col) AND SIZE(Prompt$,1)>=Max_row THEN
1900 Prompt_by_col=0
1910 ELSE
1920 Prompt_by_col=1
1930 END IF
1940 ON KNOB .01,Pri GOSUB Knob_isr
1950 ON KBD ALL,Pri GOSUB Kbd_isr
1960 GOSUB Print_page
1970 GOSUB Highlight_box
1980 New_entry$="EMPTY"
1990 ENABLE
2000 REPEAT
2010 IF Prompt_by_col THEN
2020 DISP Prompt$(Col)
2030 ELSE
2040 DISP Prompt$(Row)
2050 END IF
2060 UNTIL New_entry$<>"EMPTY" OR FNUser_key_press
2070 GOSUB Clear_old_box
2080 DISP
2090 SUBEXIT
2100 Print_page: !-----------------------------------------------------
2110 Start_row=MIN(Start_row,Max_row-Lines_per_page+1,Row)
2120 Start_row=MAX(Start_row,Row-Lines_per_page+1,1)
2130 CONTROL CRT,0;1 !character column 1
2140 CONTROL CRT,1;1 !row 1
2150 OUTPUT CRT;Iv_ul$;Green$;
2160 IF BASE(Title$,2)=0 THEN !there is a title
2170 OUTPUT CRT;FNUser_fill$(Title$(1,0),SUM(Col_width)+Max_col)
2180 ELSE
2190 OUTPUT CRT;FNUser_fill$("",SUM(Col_width)+Max_col)
2200 END IF
2210 OUTPUT CRT;Iv$;
2220 FOR C=1 TO Max_col !do first title row
2230 OUTPUT CRT;FNUser_fill$(Title$(C,1),Col_width(C))&"|";
2240 NEXT C
2250 OUTPUT CRT;Iv_ul$
2260 FOR C=1 TO Max_col !do second title row
2270 OUTPUT CRT;FNUser_fill$(Title$(C,2),Col_width(C))&"|";
2280 NEXT C
2290 FOR R=Start_row TO MIN(Max_row,Start_row+Lines_per_page-1) !do each row
2300 OUTPUT CRT;Iv_ul$;Cyan$
2310 FOR C=1 TO Max_col !do each column of the row
2320 IF C=Modify_col THEN OUTPUT CRT;Ul$;White$; !switch off inverse
2330 OUTPUT CRT;FNUser_fill$(Box$(C,R),Col_width(C))&"|";
2340 NEXT C
2350 NEXT R
2360 OUTPUT CRT;De_off$;White$;
2370 RETURN
2380 Move_box: !----------------------------------------------------
2390 Col=MAX(Modify_col,MIN(Max_col,Col))
2400 Row=MAX(1,MIN(Max_row,Row))
2410 GOSUB Clear_old_box
2420 IF (Row<Start_row) OR (Row>=Start_row+Lines_per_page) THEN
2430 GOSUB Print_page
2440 END IF
2450 GOSUB Highlight_box
2460 RETURN
2470 Clear_old_box: !--------------------------------------------------
2480 !re-write old_row without inverse video
2490 CONTROL CRT,0;1 !character column 1
2500 CONTROL CRT,1;Old_row-Start_row+3+1
2510 OUTPUT CRT;Iv_ul$;Cyan$;
2520 FOR C=1 TO Max_col !do each column of the row
2530 IF C=Modify_col THEN OUTPUT CRT;Ul$;White$; !switch off inverse
2540 OUTPUT CRT;FNUser_fill$(Box$(C,Old_row),Col_width(C))&"|";
2550 NEXT C
2560 OUTPUT CRT;De_off$;White$;
2570 RETURN
2580 Highlight_box: !--------------------------------------------------
2590 !then write new row with inverse video
2600 CONTROL CRT,0;1 !character column 1
2610 CONTROL CRT,1;Row-Start_row+3+1
2620 OUTPUT CRT;Iv_ul$;Cyan$;
2630 FOR C=1 TO Max_col !do each column of the row
2640 IF C=Modify_col THEN OUTPUT CRT;Ul$;White$; !switch off inverse
2650 IF C=Col THEN
2660 OUTPUT CRT;Iv_ul$;Yellow$;
2670 OUTPUT CRT;FNUser_fill$(Box$(C,Row),Col_width(C))&Ul$&White$&"|";
2680 ELSE
2690 OUTPUT CRT;FNUser_fill$(Box$(C,Row),Col_width(C))&"|";
2700 END IF
2710 NEXT C
2720 OUTPUT CRT;De_off$;White$;
2730 Old_row=Row !save to erase
2740 RETURN
2750 Knob_isr:DISABLE !-----------------------------------------------
2760 Knobx_counter=KNOBX+Knobx_counter
2770 IF Itf_kbd THEN !assume the knob is a mouse.
2780 Knoby_counter=Knoby_counter-KNOBY !mice do Y backwards.
2790 ELSE
2800 Knoby_counter=Knoby_counter+KNOBY
2810 END IF
2820 IF ABS(Knobx_counter)>Knob_trigger THEN
2830 IF (Modify_col=Max_col) AND NOT Itf_kbd THEN !1 column, no X
2840 Row=Row+(Knobx_counter DIV Knob_trigger)
2850 ELSE
2860 Col=Col+(Knobx_counter DIV Knob_trigger)
2870 END IF
2880 GOSUB Move_box
2890 Knobx_counter=0
2900 END IF
2910 IF ABS(Knoby_counter)>Knob_trigger THEN
2920 Row=Row+(Knoby_counter DIV Knob_trigger)
2930 GOSUB Move_box
2940 Knoby_counter=0
2950 END IF
2960 ENABLE
2970 RETURN
2980 Kbd_isr:DISABLE !-------------------------------------------------
2990 My_kbd$=KBD$ !read system keyboard buffer
3000 IF LEN(My_kbd$)>0 THEN
3010 IF NUM(My_kbd$[1])=255 THEN ! non-ASCII key pressed
3020 SELECT NUM(My_kbd$[2])
3030 CASE 94 !up arrow is CHR$(255)&CHR$(94)
3040 Row=Row-1
3050 GOSUB Move_box
3060 CASE 86 !down arrow
3070 Row=Row+1
3080 GOSUB Move_box
3090 CASE 40,60 !left
3100 Col=Col-1
3110 GOSUB Move_box
3120 CASE 41,62
3130 Col=Col+1 !right
3140 GOSUB Move_box
3150 CASE 71
3160 Col=Max_col !shift right
3170 GOSUB Move_box
3180 CASE 72
3190 Col=1 !shift left
3200 GOSUB Move_box
3210 CASE 84 !shift down
3220 Row=Max_row
3230 GOSUB Move_box
3240 CASE 87 !shift up
3250 Row=1
3260 GOSUB Move_box
3270 CASE 92,95 !home
3280 Row=1
3290 Col=1
3300 GOSUB Move_box
3310 CASE 44 !next
3320 Row=Row+Lines_per_page
3330 GOSUB Clear_old_box
3340 Start_row=Start_row+Lines_per_page
3350 Row=MAX(1,MIN(Max_row,Row))
3360 GOSUB Print_page
3370 GOSUB Highlight_box
3380 CASE 39 !prev
3390 Row=Row-Lines_per_page
3400 GOSUB Clear_old_box
3410 Start_row=Start_row-Lines_per_page
3420 Row=MAX(1,MIN(Max_row,Row))
3430 GOSUB Print_page
3440 GOSUB Highlight_box
3450 CASE 69,88,38,115,116!ENTER, EXECUTE, SELECT, mouse buttons
3460 !mouse buttons won't work after a GRAPHICS INPUT IS
3470 My_kbd$=""
3480 GOSUB Get_entry
3490 CASE 49 TO 56 !K1 to K8
3500 CALL User_log_key(NUM(My_kbd$[2])-48)
3510 CASE 75 !clr scr
3520 BEEP 651,.03!ignore key
3530 CASE ELSE
3540 OUTPUT KBD USING "#,K";My_kbd$ !pass key to op system
3550 END SELECT
3560 ELSE !first char<>255, ASCII key, must be for box
3570 GOSUB Get_entry
3580 END IF
3590 END IF !LEN >0
3600 ENABLE
3610 RETURN
3620 Get_entry: !---------------------------------------------------
3630 OUTPUT KBD USING "#,K";My_kbd$
3640 IF Prompt_by_col THEN
3650 DISP Yellow$;Prompt$(Col);" ";White$;
3660 ELSE
3670 DISP Yellow$;Prompt$(Row);" ";White$;
3680 END IF
3690 LINPUT New_entry$
3700 DISP
3710 RETURN
3720 SUBEND
3730 !----------------------------------------------------------------------
3740 User_clr_scr:SUB User_clr_scr
3750 !This subprogram clears the screen.
3760 OUTPUT 2 USING "#,K";CHR$(255)&"K"
3770 !do GCLEAR if not bit mapped.
3780 IF NOT POS(SYSTEM$("CRT ID"),"GB") THEN GCLEAR
3790 SUBEND
3800 !----------------------------------------------------------------------
3810 User_fill:DEF FNUser_fill$(S$,Length)
3820 !This function returns a string with spaces padded to the requested length.
3830 DIM T$[255]
3840 T$=S$
3850 IF LEN(T$)>=Length THEN
3860 T$=T$[1,Length]
3870 ELSE
3880 T$=RPT$(" ",INT((Length-LEN(T$))/2))&T$ !pad front
3890 T$=T$&RPT$(" ",Length-LEN(T$)) !pad back
3900 END IF
3910 RETURN T$
3920 FNEND
3930 !----------------------------------------------------------------------
3940 User_log_key:SUB User_log_key(New_key_no)
3950 !This subprogram is called by the User_keyXisr subprograms, which are
3960 !called by ON KEY statements. It logs the key by putting the New_key_no
3970 !in common.
3980 COM /User_key/ INTEGER Key_no,None
3990 IF Key_no=None THEN
4000 Key_no=New_key_no
4010 ELSE !a previous key has not been serviced
4020 BEEP 651,.03
4030 END IF
4040 SUBEND
4050 !----------------------------------------------------------------------
4060 SUB User_key1isr
4070 !These softkey interrupt service routines are called by ON KEY statements.
4080 !They call User_log_key to log the softkey press.
4090 CALL User_log_key(1)
4100 SUBEND
4110 SUB User_key2isr
4120 CALL User_log_key(2)
4130 SUBEND
4140 SUB User_key3isr
4150 CALL User_log_key(3)
4160 SUBEND
4170 SUB User_key4isr
4180 CALL User_log_key(4)
4190 SUBEND
4200 SUB User_key5isr
4210 CALL User_log_key(5)
4220 SUBEND
4230 SUB User_key6isr
4240 CALL User_log_key(6)
4250 SUBEND
4260 SUB User_key7isr
4270 CALL User_log_key(7)
4280 SUBEND
4290 SUB User_key8isr
4300 CALL User_log_key(8)
4310 SUBEND
4320 !----------------------------------------------------------------------
4330 DEF FNUser_get_key
4340 !This function returns the softkey number and clears the softkey log.
4350 COM /User_key/ INTEGER Key_no,None
4360 Temp=Key_no
4370 Key_no=None
4380 RETURN Temp
4390 FNEND
4400 !----------------------------------------------------------------------
4410 DEF FNUser_check_key
4420 !This function returns softkey number if a softkey has been pressed,
4430 !0 if not. Does not clear the key log.
4440 COM /User_key/ INTEGER Key_no,None
4450 IF Key_no<>None THEN
4460 RETURN Key_no
4470 ELSE
4480 RETURN 0
4490 END IF
4500 FNEND
4510 !----------------------------------------------------------------------
4520 DEF FNUser_key_press
4530 !This function returns 1 if a softkey has been pressed, 0 if not.
4540 COM /User_key/ INTEGER Key_no,None
4550 IF Key_no<>None THEN
4560 RETURN 1
4570 ELSE
4580 RETURN 0
4590 END IF
4600 FNEND
4610 !----------------------------------------------------------------------
4620 User_keylabel:DEF FNUser_keylabel$(Label$)
4630 !This function centers a softkey label.
4640 INTEGER Stat,Columns,Spaces
4650 DIM A$[20],B$[20]
4660 Label$=TRIM$(Label$)
4670 STATUS KBD,9;Stat
4680 IF BIT(Stat,5) THEN ! Keyboard is 46020, two 8-character halves
4690 IF POS(Label$," ") THEN ! there are two words
4700 A$=Label$[POS(Label$," ")+1] ! get second half of string
4710 Columns=8
4720 GOSUB User_kl_center
4730 IF LEN(A$)<=Columns THEN ! didn't run over
4740 B$=A$ ! remember this for return
4750 A$=Label$[1;POS(Label$," ")-1] ! get first half of string
4760 GOSUB User_kl_center
4770 A$=A$&B$
4780 A$=A$[1;16]
4790 ELSE ! did run over
4800 A$=Label$[1;MIN(LEN(Label$),16)]
4810 END IF
4820 ELSE ! there's only one word
4830 A$=Label$
4840 Columns=8
4850 GOSUB User_kl_center
4860 A$=A$[1;16]
4870 END IF
4880 ELSE ! one 14-character field
4890 A$=Label$
4900 Columns=14
4910 GOSUB User_kl_center
4920 A$=A$[1;14]
4930 END IF
4940 RETURN A$
4950 !
4960 User_kl_center:!
4970 ! This subroutine centers A$ assuming a column width of Column.
4980 ! Spaces
4990 Spaces=(Columns-LEN(A$)) DIV 2
5000 IF Spaces>0 THEN
5010 A$=RPT$(" ",Spaces)&A$&RPT$(" ",Spaces)
5020 END IF
5030 IF LEN(A$)<Columns THEN A$=A$&" "
5040 RETURN
5050 FNEND
5060 !-------------------------------------------------------------------
5070 User_error:SUB User_error(Aline$)
5080 !This subprogram reports errors to the user using the DISP line,
5090 !beeps, waits 3 sec, and exits.
5100 BEEP 100,.1
5110 DISP Aline$
5120 WAIT 3
5130 DISP
5140 SUBEND
5150 !-------------------------------------------------------------------
5160 User_stop:SUB User_stop(Aline$)
5170 !This subprogram reports fatal program errors and PAUSEs the program.
5180 !The STEP key can be used to get back to the calling context.
5190 BEEP 100,.5
5200 DISP Aline$
5210 PAUSE
5220 DISP
5230 SUBEND
5240 !-------------------------------------------------------------------
5250 ! a form feed =>
5260 User_yes:DEF FNUser_yes(Prompt$,Default)
5270 ! This subprogram asks a yes/no question, return 1 if yes, 0 if no.
5280 Left_arrow$=CHR$(255)&"H"
5290 REPEAT
5300 IF Default THEN
5310 OUTPUT 2 USING "#,K";"Y"&Left_arrow$
5320 ELSE
5330 OUTPUT 2 USING "#,K";"N"&Left_arrow$
5340 END IF
5350 DISP Prompt$&" ?"
5360 ENTER 2;Answer$
5370 DISP
5380 Answer$=UPC$(TRIM$(Answer$))
5390 UNTIL Answer$[1,1]="Y" OR Answer$[1,1]="N"
5400 IF Answer$[1,1]="Y" THEN
5410 RETURN 1
5420 ELSE
5430 RETURN 0
5440 END IF
5450 FNEND
5460 !-----------------------------------------------------------------------