| What do you mean by "declaring" an AST? $DCLAST is used to ensure
that a routine is called as an AST, not to declare it as you might
declare an integer variable. From Fortran, your ASTs are simple
subroutines or functions, but you should make sure you declare them
as EXTERNAL. Here's a short program using ASTs on a VAXstation:
OPTIONS /EXTEND_SOURCE
PROGRAM Drag
! PROGRAM DESCRIPTION:
!
! This program demonstrates how to drag something around.
!
! AUTHORS:
!
! J.D. Callas
!
! CREATION DATE: 16-Oct-1985
!
!
! C H A N G E L O G
!
! Date | Name | Description
!---------------+-------+-----------------------------------------------------
![change_entry]
!
IMPLICIT INTEGER*4 (a-z)
INCLUDE 'sys$library:uisusrdef /NOLIST'
EXTERNAL pointer_ast
REAL*4 x,y
COMMON /stuff/ vd_id, wd_id, keybuf, x, y, enabled
vd_id = uis$create_display(0.0, 0.0,100.0,100.0,10.0,10.0)
wd_id = uis$create_window(vd_id,'sys$workstation','Sample Drag Routine')
call uis$set_writing_mode(vd_id,0,1,uis$c_mode_comp)
x = 50.0
y = 50.0
enabled = .false.
call draw_checks(x,y)
call uis$set_button_ast(vd_id,wd_id,pointer_ast,x,keybuf)
call sys$hiber
END
SUBROUTINE draw_checks (xx,yy)
IMPLICIT integer*4 (a-z)
REAL*4 x,y,xx,yy
COMMON /stuff/ vd_id, wd_id, keybuf, x, y, enabled
INTEGER*2 bits
DATA bits /'A5A5'X/
call uis$image(vd_id,1,xx-5.0,yy-5.0,xx+5.0,yy+5.0,4,4,1,bits)
RETURN
END
SUBROUTINE pointer_ast (unused_variable)
IMPLICIT INTEGER*4 (a-z)
COMMON /stuff/ vd_id, wd_id, keybuf, x, y, enabled
INTEGER*2 keybuf(2)
REAL*4 x,y,pointer_x,pointer_y
EXTERNAL move_ast,cancel
IF (keybuf(2) .lt. 0) THEN
IF (keybuf(1) .ne. 400) RETURN
call uis$get_pointer_position(vd_id,wd_id,pointer_x,pointer_y)
call uis$sound_click('sys$workstation',5)
call uis$set_pointer_ast(vd_id,wd_id,move_ast,0,,,,,
1 cancel,0)
call draw_checks(x,y)
call draw_checks(pointer_x,pointer_y)
x = pointer_x
y = pointer_y
enabled = .true.
ELSE
call cancel_movement_ast
END IF
RETURN
END
SUBROUTINE move_ast (useless_variable)
IMPLICIT INTEGER*4 (a-z)
COMMON /stuff/ vd_id, wd_id, keybuf, x, y, enabled
INTEGER*2 keybuf(2)
REAL*4 x,y,pointer_x,pointer_y
call uis$get_pointer_position(vd_id,wd_id,pointer_x,pointer_y)
call draw_checks(x,y)
call draw_checks(pointer_x,pointer_y)
x = pointer_x
y = pointer_y
RETURN
END
SUBROUTINE cancel (useless_variable)
call cancel_movement_ast
type *,'You left the viewport.'
RETURN
END
SUBROUTINE cancel_movement_ast (useless_variable)
logical*4 enabled
COMMON /stuff/ vd_id, wd_id, keybuf, x, y, enabled
IF (enabled) call uis$set_pointer_ast(vd_id,wd_id,,)
enabled = .false.
RETURN
END
|