| <<< VWSENG::DISK:[NOTES$LIBRARY]VWS_V1.NOTE;1 >>>
-< MicroVAX Workstations >-
================================================================================
Note 20.35 Awful mouse cursor 35 of 93
WHERE::EVANS "Robert N. Evans DTN-225-6946 HLO2-3/" 893 lines 14-APR-1987 19:01
-< A Deluxe Cursor Setting Program >-
--------------------------------------------------------------------------------
$! Attached is the source of my deluxe cursor setting program:
$!
$! 1) Extract and '@' this note to place the source files into your current
$! default directory.
$!
$! 2) Edit PATT.MAR if you want to add new cursor shapes there are several
$! already defined.
$!
$! 3) Use the command @PATT to build the program from sources. This takes
$! several minutes...be patient.
$!
$! 4) Edit PATT.CLD to contain a file specification for where PATT.EXE can
$! be found on your system. If you change the line to be "Image PATT" then
$! you must putt PATT.EXE into SYS$SYSTEM:.
$!
$! 5) Issue the command SET COMMAND PATT to define the DCL verb CURSOR in your
$! current process. The CURSOR verb is used to invoke the pattern setting
$! program. See the VMS documentation on Command Definition if you want to
$! make the CURSOR verb available system-wide.
$!
$! 6) Use the command CURSOR <PATTERN_NAME> to change the shape of the cursor.
$! Inside PATT.MAR are more comments on using this DCL verb.
$!
$! This program has been tested and found to work as intended on both a
$! VAXstation-II (QVSS) and a VAXstation-II/GPX Intensity system. No testing
$! is planned for color or VAXstar systems.
$!
$! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
$!
$ Write Sys$Output " "
$ Write Sys$Output "Creating the Command Definition File"
$ Create/Log PATT.CLD
$ Deck
Define Verb Cursor
Image "USR$:[EVANS.CURSOR]PATT"
Parameter P1, Prompt="Cursor_Pattern?", Value(Required)
Qualifier MODE, NonNegatable, Value(Required, Type=$Number)
Qualifier PLANE, NonNegatable, Value(Required, Type=Plane_Keywords)
Qualifier POSITION, NonNegatable, Value(Required, Type=XY_Position, List)
DisAllow X_Position AND NOT Y_Position
DisAllow Y_Position AND NOT X_Position
Define Type Plane_Keywords
KeyWord BackGround
KeyWord Both_Planes
KeyWord ForeGround
Define Type XY_Position
KeyWord X_Position, Value(Required)
KeyWord Y_Position, Value(Required)
$ EOD
$!
$ Write Sys$Output " "
$ Write Sys$Output "Creating the Build Procedure File"
$ Create/Log PATT.COM
$ Deck
$ If f$Search("UIS.MLB") .nes. "" Then Goto Have_Library
$ Library/Create/Macro UIS Sys$Library:VWSSYSDEF,UISUSRDEF,UISMSG,HCUISDEF
$Have_Library:
$ Macro PATT+UIS/Lib
$ Message PATTMSG
$ Link PATT+PATTMSG /NoTraceback
$ EOD
$!
$ Write Sys$Output " "
$ Write Sys$Output "Creating the Program Source File"
$ Create/Log PATT.MAR
$ Deck
.TITLE SET_CURSOR - Hardware Pattern in VC/VA Device
.IDENT /V03.02-003/
;
; COPYRIGHT (C) 1984, 1985, 1986, 1987
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A SINGLE
; COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION OF THE
; ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANY OTHER COPIES THEREOF,
; MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
; EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
; TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES
; REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;
;Build the program like this:
; $LIBRARY/CREATE/MACRO UIS Sys$Library:VWSSYSDEF
; $MACRO SETCURSOR+UIS/LIB
; $LINK SETCURSOR
;++
; FACILITY: VWS Example Program
;
; FUNCTIONAL DESCRIPTION:
;
; This program uses the QIO interface to the workstation device to
; set the hardware cursor pattern. The cursors in this include a
; modified version of Dave Marra's mouse, and a pencil and spray can
; adapted from the Macintosh.
;
;
; ENVIRONMENT: User Mode, VAX/VMS
;
; AUTHOR: ??? Jon Callas ???, CREATION DATE: ?? Feb 1985 ??
;
; Code was freely adapted from Steve Zalewski's QVTEST program.
; Mouse cursor adapted from Dave Marra's cursor.
;
; MODIFIED BY:
; RE Robert Evans
; WB Bill Barabash
;
; REVISION HISTORY:
; V3.02 26-Dec-1986 RE Added 2-Plane Cursor support, DCL command
; interface to a library of cursor patterns.
; Add macros for defining the cursor shape so the
; cursor appears on the screen like it does in the
; the source, without Left <-> Right reversal.
; Added some new patterns.
; 22-MAY-1986 WB Added COFFEE-MUG cursor
; V3.01 20-MAY-1986 RE Added Skull/Crossbones cursor
;--
.PAGE
.SBTTL DECLARATIONS
;
; INCLUDED SYSTEM-WIDE DEFINITIONS:
;
$CLIMSGDEF ; CLI status codes
$DSCDEF ; Descriptor offsets
$IODEF ; I/O Function codes
$QVBDEF ; QVSS Definitions
$SSDEF ; System Status codes
;
; Locally defined MACROS:
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Macro to define the beginning of a cursor pattern
;
.MACRO PATTERN_INIT name one_plane=FORE ?label
.IF B name
.ERROR ; Pattern must be NAMEd
.MEXIT
.ENDC
.IIF NDF PAT_INITED, PAT_INITED=0
.IF NE PAT_INITED
.ERROR ; Missing PATTERN_END
.MEXIT
.ENDC
PAT_INITED = 1 ; within a pattern
PAT_LINE = 16 ; 16 - <current pattern line>
PAT_HSCOL = 16 ; HotSpot column
PAT_HSLINE = 16 ; HotSpot line
;
.PSECT CURSOR_DEF
PAT_CUR'label: ; pointers to this pattern def.
PAT_DEFPTR = .
PAT_VARPTR = .
.BLKB PAT_K_LENGTH
. = . - PAT_K_LENGTH
;
.PSECT KEYWORD_NAMES
PAT_KEY'label: ; stuff for LIB$LOOKUP_KEY
.ASCIC !name!
;
.PSECT KEYWORD_TABLE
.ADDRESS PAT_KEY'label ; * "
.ADDRESS PAT_CUR'label
PAT_NUM_KEYS = PAT_NUM_KEYS + 1
;
; ; default 1-Plane pattern is:
PAT_1PLANE = PAT_T_'one_plane'_PLANE ; FORE, BACK, or BOTH
.IIF IDN <one_plane> <FORE>, .MEXIT
.IIF IDN <one_plane> <BACK>, .MEXIT
.IIF IDN <one_plane> <BOTH>, .MEXIT
PAT_1PLANE = PAT_T_FORE_PLANE ; Assume 1plane = FORE
.WARN ; ONE__PLANE is incorrectly specified
.PRINT ; ONE__PLANE must be either FORE, BACK, or BOTH
.PRINT ; ONE__PLANE is being defaulted to FORE
.ENDM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Macro to define one line of pixels in the cursor pattern
;
; character usage: Not_Hot_Spot Hot_Spot
; Foreground ------- f F X x
; Background ------- b B H h
; Invisible ------- . +
.MACRO PATTERN_LINE line=<................>
.IF NDF PAT_INITED
.ERROR ; Missing PATTERN_INIT
.MEXIT
.ENDC
.IF EQ PAT_INITED
.ERROR ; Missing PATTERN_INIT
.MEXIT
.ENDC
.IF EQ PAT_LINE
.ERROR ; Too many PATTERN_LINEs
.MEXIT
.ENDC
PAT_LINE = PAT_LINE - 1
.IF NE %LENGTH(line) - 16
.ERROR %LENGTH(line) ; Pattern_LINE must contain 16 characters
.MEXIT
.ENDC
PAT_P1L = 0 ; assemble BOTH pixels here
PAT_P2L = 0 ; assemble FOREGROUND pixels
PAT_P3L = 0 ; assemble BACKGROUND pixels
PAT_COL = -1 ; current column of line
.IRPC chr,<line> ; loop for each pixel of this
; scan line, left to right
PAT_COL = PAT_COL + 1
PAT_P2 = 0 ; set if FORE ground pixel
PAT_P3 = 0 ; set if BACK ground pixel
.IIF EQ %LOCATE(chr,<bBfFhHxX.+>)-10, .ERROR ; Invalid Pattern Character
.IF NE %LOCATE(chr,<hHxX+>)-5
.IIF NE PAT_HSCOL-16, .WARN ; Hotspot Location being redefined
PAT_HSCOL = PAT_COL
PAT_HSLINE = PAT_LINE
.ENDC
.IIF NE %LOCATE(chr,<fFxX>)-4, PAT_P2 = ^X8000 ; foreground
.IIF NE %LOCATE(chr,<bBhH>)-4, PAT_P3 = ^X8000 ; background
PAT_P1L = PAT_P1L @ -1 ! PAT_P2 ! PAT_P3
PAT_P2L = PAT_P2L @ -1 ! PAT_P2
PAT_P3L = PAT_P3L @ -1 ! PAT_P3
.ENDR
.PSECT CURSOR_DEF ; generate pattern line defs
. = PAT_VARPTR + PAT_T_FORE_PLANE
.WORD PAT_P2L
. = PAT_VARPTR + PAT_T_BACK_PLANE
.WORD PAT_P3L
ASSUME PAT_T_BOTH_PLANE EQ 0
. = PAT_VARPTR
.WORD PAT_P1L
PAT_VARPTR = .
.ENDM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Macro to define the end of a cursor pattern
;
.MACRO PATTERN_END mode=0
.IF NDF PAT_INITED
.ERROR ; Missing PATTERN_INIT
.MEXIT
.ENDC
.IF EQ PAT_INITED
.ERROR ; Missing PATTERN_INIT
.MEXIT
.ENDC
PAT_INITED = 0
.IIF GT PAT_LINE, .WARN PAT_LINE ; Too few PATTERN_LINEs
.IF EQ PAT_HSLINE-16
.WARN ; Hot Spot location never defined
PAT_HSCOL = 8
PAT_HSLINE = 8
.ENDC
.PSECT CURSOR_DEF
. = PAT_DEFPTR + PAT_L_HOTSPOT_X
ASSUME PAT_L_HOTSPOT_Y EQ <PAT_L_HOTSPOT_X + 4>
.LONG PAT_HSCOL, <15-PAT_HSLINE> ; HotSpot location
ASSUME PAT_L_MODE EQ <PAT_L_HOTSPOT_Y + 4>
.LONG mode ; QVSS Cursor Mode
ASSUME PAT_L_1PLANE EQ <PAT_L_MODE + 4>
.LONG PAT_1PLANE ; default 1Plane pattern
; ensure correct Location Counter in this PSECT = first byte after cursor def
ASSUME . EQ <PAT_DEFPTR + PAT_K_LENGTH>
.ENDM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; EQUATED SYMBOLS:
;
BUFLEN = 256
;
$DEFINI PAT,GLOBAL ; Define the layout of a defined cursor pattern
; as stored in PSECT CURSOR_DEF
;
; Bitmaps for cursors, ordering is that required
; by the SET_CURSOR I/O Function
$DEF PAT_T_BOTH_PLANE .BLKW 16 ; 1 = pixels in either
$DEF PAT_T_FORE_PLANE .BLKW 16 ; 1 = foreground pixels
$DEF PAT_T_BACK_PLANE .BLKW 16 ; 1 = background pixels
$DEF PAT_L_HOTSPOT_X .BLKL ; hotspot location
$DEF PAT_L_HOTSPOT_Y .BLKL ; *
$DEF PAT_L_MODE .BLKL ; default 1-plane mode
$DEF PAT_L_1PLANE .BLKL ; default 1-plane plane
$DEF PAT_K_LENGTH
$DEFEND PAT,GLOBAL
;
; OWN STORAGE:
;
; read/write storage
;
.PSECT LOCAL,LONG,noPIC,USR,CON,REL,LCL,NOSHR,NOEXE,WRT,NOVEC
;
QVBDES: .BLKL 2 ; addr and len of QVB
RETDES: ; addr and len of misc string
.LONG BUFLEN ; descriptor of 'BUFFER'
.ADDRESS BUFFER
RETLEN = RETDES + DSC$W_LENGTH
GV_ARGS: .LONG 3 ; arglist for calling CLI$GET_VALUE
GV_DES: .LONG 0 ; entity_desc
.ADDRESS BUFDES ; result buffer
.ADDRESS RETLEN ; result length
LK_ARGS: .LONG 3 ; arglist for calling LIB$LOOKUP_KEY
.ADDRESS RETDES ; string to lookup
LK_TBL: .LONG 0 ; keyword table
.ADDRESS TEMPTR ; receives keyword value
CV_ARGS: .LONG 6 ; arglist for calling OTS$CVT_T_F
.ADDRESS RETDES ; input string
CV_RES: .LONG 0 ; result addr
.LONG 0 ; digits-in-fract
.LONG 0 ; scale-factor
.LONG 1 ; flags: ignore blanks
.LONG 0 ; ext-bits
TEMPTR: .BLKL 1 ; general temporary to receive results
CURPOS: ; cursor position array
XPOS: .BLKL 1 ; distance from screen left edge
YPOS: .BLKL 1 ; distance up from screen bottom
CHAN1: .BLKW 1 ; channel assigned
IOSTAT: .BLKW 4 ; I/O Status Block
BUFFER: .BLKB BUFLEN ; misc string buffer
;
; read-only storage
;
.PSECT PDATA,LONG,noPIC,USR,CON,REL,LCL,SHR,NOEXE,NOWRT,NOVEC
;
BUFDES: .LONG BUFLEN ; descriptor of 'BUFFER'
.ADDRESS BUFFER
TT_DESC: .ASCID /SYS$WORKSTATION/ ; name of workstation device
P1_DESC: .ASCID /P1/ ; name of command parameter
MO_DESC: .ASCID /MODE/ ; name of command qualifier
PL_DESC: .ASCID /PLANE/ ; *
PO_DESC: .ASCID /POSITION/ ; *
XP_DESC: .ASCID /X_POSITION/ ; name of keyword
YP_DESC: .ASCID /Y_POSITION/ ; *
PLNTBL: $LIB_KEY_TABLE < - ; keywords used in /PLANE qualifier
<BOTH_PLANES, PAT_T_BOTH_PLANE>, -
<FOREGROUND, PAT_T_FORE_PLANE>, -
<BACKGROUND, PAT_T_BACK_PLANE>>
.PSECT CURSOR_DEF,NOEXE,PIC,SHR,NOWRT ; contains pattern defs
;
.PSECT KEYWORD_NAMES,NOEXE,PIC,SHR,NOWRT ; contains keyword names
;
.PSECT KEYWORD_TABLE,NOEXE,NOPIC,SHR,NOWRT ; contains keyword table
NAMTBL: .LONG 2*PAT_NUM_KEYS
PAT_NUM_KEYS = 0
.PAGE
.SBTTL Cursor Patterns
;
; Define the cursor patterns
;
; character usage: Not_Hot_Spot Hot_Spot
; Foreground ------- f F X x
; Background ------- b B H h
; Invisible ------- . +
PATTERN_INIT CROSSHAIR ; Define "CROSSHAIR" cursor
;
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE fffffff+fffffff.
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE .......f........
PATTERN_LINE ................
PATTERN_END
PATTERN_INIT MOUSE ; Define "MOUSE" cursor
;
PATTERN_LINE .......fff......
PATTERN_LINE .........fx.....
PATTERN_LINE ........ff......
PATTERN_LINE .......ff.......
PATTERN_LINE ..ffffffffffff..
PATTERN_LINE .fBBBBBBBBBBBBf.
PATTERN_LINE ffBffBBffBBffBff
PATTERN_LINE ffBffBBffBBffBff
PATTERN_LINE ffBffBBffBBffBff
PATTERN_LINE ffBBBBBBBBBBBBff
PATTERN_LINE ffBBBBBBBBBBBBff
PATTERN_LINE ffffBBBBBBBBffff
PATTERN_LINE ff..ffBBBBff..ff
PATTERN_LINE .ff...ffff...ff.
PATTERN_LINE ..ff.fBBBBf.ff..
PATTERN_LINE ...ffffffffff...
PATTERN_END
.PAGE
PATTERN_INIT COFFEE_MUG ; Define "COFFEE" cursor
PATTERN_LINE ...fffffffff....
PATTERN_LINE ..fBBBBBBBBBf...
PATTERN_LINE ffBBBBBBBBBBff..
PATTERN_LINE fBffBBBBBBBfBf..
PATTERN_LINE fBBBfffffffBBf..
PATTERN_LINE fBBBBBBBBBBBBff.
PATTERN_LINE fBBBBBBBBBBBBff.
PATTERN_LINE fBBBBBBBBBBBBf.f
PATTERN_LINE fBBBBBBBBBBBBf.f
PATTERN_LINE fBffBBBxBBffBf.f
PATTERN_LINE fBfBfBfBfBfBff.f
PATTERN_LINE fBfBfBfffBfBffff
PATTERN_LINE fBffBBfBfBffBff.
PATTERN_LINE fBBBBBBBBBBBBf..
PATTERN_LINE fBBBBBBBBBBBBf..
PATTERN_LINE .ffffffffffff...
PATTERN_END
;
PATTERN_INIT PIRATE ; Skull and Cross Bones pattern
PATTERN_LINE BBBBBBffffBBBBBB
PATTERN_LINE BBBBBffffffBBBBB
PATTERN_LINE BBBBffffffffBBBB
PATTERN_LINE BBBff..ff..ffBBB
PATTERN_LINE BBBff..ff..ffBBB
PATTERN_LINE BBBBffffffffBBBB
PATTERN_LINE BBBBBffffffBBBBB
PATTERN_LINE BBBBBBffffBBBBBB
PATTERN_LINE BfBBBBffffBBBBfB
PATTERN_LINE ffBBBBffffBBBBff
PATTERN_LINE BBfBBBBffBBBBfBB
PATTERN_LINE BBBfffBBBBfffBBB
PATTERN_LINE BBBBBBfxffBBBBBB
PATTERN_LINE fBBBffffffffBBBf
PATTERN_LINE fffffBBBBBBfffff
PATTERN_LINE BfBBBBBBBBBBBBfB
PATTERN_END
;
PATTERN_INIT PENCIL ; "MACpaint" style pencil pattern
PATTERN_LINE ................
PATTERN_LINE ................
PATTERN_LINE .....fff........
PATTERN_LINE ....f...f.......
PATTERN_LINE ....f...f.......
PATTERN_LINE ...fBfff........
PATTERN_LINE ...fBBBf........
PATTERN_LINE ..fBBBf.........
PATTERN_LINE ..fBBBf.........
PATTERN_LINE .fBBBf..........
PATTERN_LINE .fBBBf..........
PATTERN_LINE ffBBf...........
PATTERN_LINE ffff............
PATTERN_LINE fff.............
PATTERN_LINE ff..............
PATTERN_LINE x...............
PATTERN_END
.PAGE
PATTERN_INIT SPRAYCAN ; "MACpaint" style spraycan pattern
PATTERN_LINE f...............
PATTERN_LINE ..f.............
PATTERN_LINE x...f.ff........
PATTERN_LINE ..f..ffff.......
PATTERN_LINE f....fBff.......
PATTERN_LINE ....ffffff......
PATTERN_LINE ....fBBBBf......
PATTERN_LINE ....fBBfff......
PATTERN_LINE ....fBBfBf......
PATTERN_LINE ....fBBfff......
PATTERN_LINE ....fBBfBf......
PATTERN_LINE ....fBBfff......
PATTERN_LINE ....fBBfff......
PATTERN_LINE ....fBBBBf......
PATTERN_LINE ....fBBBBf......
PATTERN_LINE ....ffffff......
PATTERN_END
;
PATTERN_INIT PLUS one_plane=BOTH ; Boxed-Plus
PATTERN_LINE BBBBBBBBBBBBBBBB
PATTERN_LINE BBBBBBBBBBBBBBBB
PATTERN_LINE BB............BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.ffffffffff.BB
PATTERN_LINE BB.fffffxffff.BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB.....ff.....BB
PATTERN_LINE BB............BB
PATTERN_LINE BBBBBBBBBBBBBBBB
PATTERN_LINE BBBBBBBBBBBBBBBB
PATTERN_END
;
PATTERN_INIT HEART one_plane=BOTH ; See-thru HEART
PATTERN_LINE ................
PATTERN_LINE ..fffffffffffff.
PATTERN_LINE .fff...fff...fff
PATTERN_LINE .ff.....f.....ff
PATTERN_LINE .f.............f
PATTERN_LINE .f.............f
PATTERN_LINE .f.............f
PATTERN_LINE .f.....B.B.....f
PATTERN_LINE .ff.....B.....ff
PATTERN_LINE .fff....+....fff
PATTERN_LINE .ffff.......ffff
PATTERN_LINE .fffff.....fffff
PATTERN_LINE .ffffff...ffffff
PATTERN_LINE .fffffff.fffffff
PATTERN_LINE ..fffffffffffff.
PATTERN_LINE ................
PATTERN_END
.PAGE
PATTERN_INIT ARROW ; UIS style Arrow
PATTERN_LINE BBB.............
PATTERN_LINE BxfBB...........
PATTERN_LINE BffffBB.........
PATTERN_LINE .BfffffBB.......
PATTERN_LINE .BfffffffBB.....
PATTERN_LINE ..BffffffffBB...
PATTERN_LINE ..BffffffffffB..
PATTERN_LINE ...BfffffBBBBB..
PATTERN_LINE ...BffffffB.....
PATTERN_LINE ....BffBfffB....
PATTERN_LINE ....BffBBfffB...
PATTERN_LINE .....BfB.BfffB..
PATTERN_LINE .....BfB..BfffB.
PATTERN_LINE ......B....BfffB
PATTERN_LINE ............BfBB
PATTERN_LINE .............BB.
PATTERN_END
;
; Program Section for the code of the following Routines
;
.PSECT $CODE,LONG,PIC,USR,CON,REL,LCL,SHR,EXE,NOWRT,NOVEC
.PAGE
.SBTTL SET_CURSOR - SET HARDWARE CURSOR PATTERN
;++
; FUNCTIONAL DESCRIPTION:
;
; Set a cursor pattern (shape) for the screen.
;
; CALLING SEQUENCE:
;
; This routine is activiated as a result of the DCL command:
;
; $ CURSOR pattern -
;
; [/MODE=#] - ! define QVSS Cursor Mode
;
; [/PLANE={BOTH_PLANES ! set to a 1-plane cursor using
; / FOREGROUND ! * the specified plane
; / BACKGROUND}] - ! * regardless of hardware
;
; [/POSITION=(X_POSITION=##.#, ! reposition the cursor to the
; Y_POSITION=##.#)] ! * specified screen location
;
; Where 'pattern' is the name of one of the cursor patterns defined above
; in this source.
;
; /MODE is used to specify a different one-plane cursor mode than that
; defined by PATTERN_INIT argument MODE. The QVSS driver defines modes:
; 0 -> Dynamic NAND with background (the default)
; 1 -> Dynamic OR with background
; 2 -> NAND with background
; 3 -> OR with background
;
; On hardware that supports a multi-plane cursor (GPX) the default is to
; set up a multi-plane cursor. The /PLANE qualifier always causes a one
; plane cursor to be loaded.
;
; If the hardware only has one cursor plane just that plane is loaded.
; The cursor definitions in this source select the default pixels used,
; either FOREground, BACKground or BOTH in the ONE_PLANE argument to
; macro PATTERN_INIT. /PLANE can be used to over-ride this default.
;
; If /POSITION is specified, the cursor is repositioned to 'X' cm. in from
; the left screen edge and 'Y' cm. above the screen bottom. The X and Y
; values may be fractional. Floating point values are accepted. If
; /POSITION is used, both X and Y must be specified with values.
;
;
; INPUT PARAMETERS:
;
; none
;
; IMPLICIT INPUTS:
;
; none
;
; OUTPUT PARAMETERS:
;
; none
;
; IMPLICIT OUTPUTS:
;
; none
;
; COMPLETION CODES:
;
; Standard R0 codes are returned for errors detected.
;
; SIDE EFFECTS:
;
; The default hardware cursor pattern in the driver is loaded.
;--
; Main program entry point
;
.ENTRY SET_CURSOR,^M<R4,R5,R6,R7,R8,R9,R10,R11>
$ASSIGN_S DEVNAM=TT_DESC,-; assign channel to WorkStation
CHAN=CHAN1 ;
BLBC R0,ERROR ; LBC if error
$QIOW_S CHAN=CHAN1,- ; Get QVB location
FUNC=#IO$_SENSEMODE,-
IOSB=IOSTAT,-
P1=IO$C_QV_GETSYS,-
P2=#QVBDES ; Receives QVB Address and Length
BLBC R0,ERROR ; LBC if error
MOVZWL IOSTAT,R0 ; get completion status
BLBC R0,ERROR ; LBC if error
BSBB PROCESS_CMD ; Process DCL Command
BLBC R0,ERROR ; LBC if error
$QIOW_S CHAN=CHAN1,- ; Define cursor shape
FUNC=#IO$_SETMODE,- ;
IOSB=IOSTAT,- ;
P1=(R7),- ; I/O Sub-function code
P2=R8,- ; Cursor shape description
P3=R9,- ; New Cursor Position
P4=R10,- ; Cursor "Hot Spot" Location
P5=R11 ; Cursor Mode
BLBC R0,ERROR ; LBC if error
MOVZWL IOSTAT,R0 ; get completion status
ERROR: RET ; Exit with status
.PAGE
.SBTTL PROCESS_CMD - Process DCL Command
;++
; FUNCTIONAL DESCRIPTION:
;
; Process the DCL command which was used to call this program.
;
; CALLING SEQUENCE:
;
; JSB PROCESS_CMD
;
; INPUT PARAMETERS:
;
; none
;
; IMPLICIT INPUTS:
;
; QVBDES describes the QVB.
; Parameters and qualifiers are fetched via DCL callback.
;
; OUTPUT PARAMETERS:
;
; R11 = Cursor Mode
; R10 -> Hotspot Location array
; R9 -> New Cursor Position array (0 if not repositioned)
; R8 -> Cursor Pattern Bitmap
; R7 = QIO sub-function code/modifier to load default cursor pattern
;
; IMPLICIT OUTPUTS:
;
; CURPOS: (XPOS, YPOS)
;
; COMPLETION CODES:
;
; Standard R0 codes are returned for any errors detected.
;
; SIDE EFFECTS:
;
; Some of the run-time routines used may signal error conditions.
; R4,R5,R6 are scratched
;--
PROCESS_CMD:
MOVL QVBDES+DSC$A_POINTER,R5 ; get QVB address
; process name of selected pattern
MOVAQ P1_DESC,GV_DES ; entity descriptor
CALLG GV_ARGS,G^CLI$GET_VALUE ; get command parameter
BLBC R0,10$ ; LBC if error
MOVAL NAMTBL,LK_TBL ; keyword table
CALLG LK_ARGS,G^LIB$LOOKUP_KEY ; lookup specified parameter
CMPL R0,#LIB$_UNRKEY ; check for unknown pattern
BNEQ 5$ ; NEQ if not unknown pattern
BRW 200$ ; output pattern error message
5$: BLBC R0,10$ ; LBC if error
MOVL TEMPTR,R6 ; ptr to specified definition
; process cursor mode
MOVL PAT_L_MODE(R6),R11 ; default 1-plane mode
;
MOVAQ MO_DESC,GV_DES ; entity descriptor
CALLG GV_ARGS,G^CLI$GET_VALUE ; get MODE qualifier
CMPL R0,#CLI$_ABSENT ; check if any was specified
BEQL 30$ ; EQL if none
BLBC R0,10$ ; LBC if error
;
CLRQ -(SP) ; build arg list: flags, val-siz
PUSHAL TEMPTR ; * result
PUSHAQ RETDES ; * input string
CALLS #4,G^OTS$CVT_TU_L ; get mode as integer
BLBS R0,20$ ; LBS if NO error
10$: BRW 110$ ; br if error
;
20$: MOVL TEMPTR,R11 ; user specified 1-plane mode
; set hotspot location
30$: MOVAL PAT_L_HOTSPOT_X(R6),R10 ; hotspot location
; process cursor repositioning (if any)
CLRL R9 ; assume no reposition
PUSHAQ PO_DESC ; entity descriptor
CALLS #1,G^CLI$PRESENT ; check if /POSITION specified
CMPL R0,#CLI$_PRESENT ; see if absent
BEQL 40$ ; EQL if /POSITION=(X:n,Y:n)
BRW 70$ ; br to skip repositioning
40$: MOVAL CURPOS,R9 ; cursor position array
;
MOVAQ XP_DESC,GV_DES ; entity descriptor
CALLG GV_ARGS,G^CLI$GET_VALUE ; get X:nn.nn value (in cm.)
BLBC R0,50$ ; LBC if error
MOVAF XPOS,CV_RES ; result addr
CALLG CV_ARGS,G^OTS$CVT_T_F ; cvt to F-Float (cm.)
BLBC R0,50$ ; LBC if error
DIVF2 #^F2.54,XPOS ; cvt to inches
CVTWF QVB$W_X_RESOL(R5),R4 ; pixels per inch horozontally
MULF2 XPOS,R4 ; X-pos in pixels
CVTRFL R4,XPOS ; * as integer
;
MOVAQ YP_DESC,GV_DES ; entity descriptor
CALLG GV_ARGS,G^CLI$GET_VALUE ; get Y:nn.nn value (in cm.)
BLBC R0,50$ ; LBC if error
MOVAF YPOS,CV_RES ; result addr
CALLG CV_ARGS,G^OTS$CVT_T_F ; cvt to F-Float (cm.)
BLBS R0,60$ ; LBS if no error
50$: BRW 110$ ; LBC if error
60$: DIVF2 #^F2.54,YPOS ; cvt to inches
CVTWF QVB$W_Y_RESOL(R5),R4 ; pixels per inch vertically
MULF2 YPOS,R4 ; Y-pos in pixels
CVTRFL R4,YPOS ; * as integer
; set-up cursor pattern bitmap and I/O function code
70$: MOVL #PAT_T_BOTH_PLANE,R8 ; assume 2-plane cursor bitmap
MOVL - ; *
#<IO$C_QV_SETCURSOR!IO$M_QV_LOAD_DEFAULT!IO$M_QV_TWO_PLANE_CURSOR>,R7
; process /PLANE=xxxx
;
MOVAQ PL_DESC,GV_DES ; entity descriptor
CALLG GV_ARGS,G^CLI$GET_VALUE ; get /PLANE qualifier
CMPL R0,#CLI$_ABSENT ; see if absent
BEQL 80$ ; EQL if no /PLANE
BLBC R0,110$ ; LBC if error
MOVAL PLNTBL,LK_TBL ; keyword table
CALLG LK_ARGS,G^LIB$LOOKUP_KEY ; lookup specified parameter
BLBC R0,110$ ; LBC if error
MOVL TEMPTR,R8 ; ptr to bitmap
BRB 90$ ; does not matter if GPX
;
80$: CMPB QVB$B_CURSOR_PLANES(R5),#1 ; check # hardware cursor planes
BGTRU 100$ ; GTR if not QVSS
MOVL PAT_L_1PLANE(R6),R8 ; default 1-plane cursor bitmap
90$: BICL2 #IO$M_QV_TWO_PLANE_CURSOR,R7 ; 1-plane function code
100$: ADDL2 R6,R8 ; point at bitmap definition
MOVL #SS$_NORMAL,R0 ; success status
110$: RSB ; return w/status
;
; Issue message for unknown pattern, listing all known patterns
;
200$: PUSHL R0 ; save error status
PUSHL R6 ; save reg
; Build LIB$SIGNAL Arg List
MOVAL NAMTBL,R0 ; addr of KeyWord Table
ASHL #-1,(R0),R1 ; # keyword entries
ADDL3 (R0)+,R1,R6 ; # args this loop will push
210$: PUSHAB @(R0)+ ; Address of ASCIC pattern name
TSTL (R0)+ ; bypass keyword value
PUSHL #1 ; # FAO args
PUSHL #CURSOR_PATTERN ; condition value
SOBGTR R1,210$ ; loop for all known patterns
;
PUSHL #0 ; # FAO args
PUSHL #CURSOR_KNOPATT ; condition value
;
PUSHAQ RETDES ; string descr of bad name
PUSHL #1 ; # FAO args
PUSHL #CURSOR_UNKNPATT ; condition value
;
ADDL2 #5,R6 ; account for remaining args
CALLS R6,G^LIB$SIGNAL ; output the message
POPL R6 ; restore reg
POPL R0 ; original status
RSB ; return w/status
.END SET_CURSOR
$ EOD
$!
$ Write Sys$Output " "
$ Write Sys$Output "Creating the Program Messages Source File"
$ Create/Log PATTMSG.MSG
$ Deck
.TITLE PATT_MSG SET CURSOR PATTERN Messages
.IDENT 'V01.00-001'
.FACILITY CURSOR,1
.SEVERITY ERROR
UNKNPATT <Unknown Cursor Pattern \!AS\> /FAO=1
.SEVERITY INFORMATIONAL
KNOPATT <Known Patterns are:>
PATTERN < !AC> /FAO=1
.END
$ EOD
$!
$ Exit
|