aboutsummaryrefslogtreecommitdiff
path: root/pkg/images/tv/iis/ids/testcode
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/images/tv/iis/ids/testcode')
-rw-r--r--pkg/images/tv/iis/ids/testcode/README2
-rw-r--r--pkg/images/tv/iis/ids/testcode/box.x83
-rw-r--r--pkg/images/tv/iis/ids/testcode/boxin.x98
-rw-r--r--pkg/images/tv/iis/ids/testcode/crin.x130
-rw-r--r--pkg/images/tv/iis/ids/testcode/grey.x90
-rw-r--r--pkg/images/tv/iis/ids/testcode/grin.x98
-rw-r--r--pkg/images/tv/iis/ids/testcode/scr.x130
-rw-r--r--pkg/images/tv/iis/ids/testcode/scrin.x130
-rw-r--r--pkg/images/tv/iis/ids/testcode/sn.x192
-rw-r--r--pkg/images/tv/iis/ids/testcode/t_giis.x67
-rw-r--r--pkg/images/tv/iis/ids/testcode/zm.x64
-rw-r--r--pkg/images/tv/iis/ids/testcode/zmin.x84
-rw-r--r--pkg/images/tv/iis/ids/testcode/zztest.x81
13 files changed, 1249 insertions, 0 deletions
diff --git a/pkg/images/tv/iis/ids/testcode/README b/pkg/images/tv/iis/ids/testcode/README
new file mode 100644
index 00000000..31198b43
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/README
@@ -0,0 +1,2 @@
+This is junk code which I think should be thrown away. I will leave it here
+for the time just in case. (LED 22/4/91)
diff --git a/pkg/images/tv/iis/ids/testcode/box.x b/pkg/images/tv/iis/ids/testcode/box.x
new file mode 100644
index 00000000..e3c1d22b
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/box.x
@@ -0,0 +1,83 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imd.h"
+include <gki.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# create a box test image
+
+procedure t_im()
+
+pointer gp
+char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int fd
+
+pointer gopen()
+bool streq()
+int open()
+
+short i,data[DIM+1]
+short set_image[6]
+int key
+real x[30],y[30]
+real lb,ub,mid
+int mod()
+
+begin
+ call clgstr("output", output, SZ_FNAME)
+ if (!streq (output, "") ) {
+ call strcpy (output, output_file, SZ_FNAME)
+ fd = open (output_file, NEW_FILE, BINARY_FILE)
+ } else
+ fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE)
+
+ call clgstr("device", device, SZ_FNAME)
+ gp = gopen ( device, NEW_FILE, fd)
+
+ # now set up boxes
+ set_image[1] = 1
+ set_image[2] = IMD_EOD
+ set_image[3] = IMD_BLUE
+ set_image[4] = IMD_EOD
+ call gescape ( gp, IMD_SET_GP, set_image, 4)
+ lb = 0.0
+ ub = 1.0
+ mid = (lb + ub)/2.
+ for ( i = 1; i <= 5 ; i = i + 1 ) {
+ if ( mod(i-1,2) == 0 ) {
+ x[1] = lb
+ y[1] = mid
+ x[2] = mid
+ y[2] = ub
+ x[3] = ub
+ y[3] = mid
+ x[4] = mid
+ y[4] = lb
+ x[5] = lb
+ y[5] = mid
+ } else {
+ x[1] = (mid-lb)/2 + lb
+ y[1] = x[1]
+ x[2] = x[1]
+ # x[2] = x[1] - .05
+ y[2] = y[1] + mid - lb
+ x[3] = y[2]
+ y[3] = y[2]
+ # y[3] = y[2] - .05
+ x[4] = y[2]
+ y[4] = x[1]
+ x[5] = x[1]
+ y[5] = y[1]
+ lb = x[1]
+ ub = y[2]
+ }
+ call gpline ( gp, x, y, 5)
+ }
+
+ # all done
+ call gclose ( gp )
+ call close ( fd )
+end
diff --git a/pkg/images/tv/iis/ids/testcode/boxin.x b/pkg/images/tv/iis/ids/testcode/boxin.x
new file mode 100644
index 00000000..e854935f
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/boxin.x
@@ -0,0 +1,98 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fio.h>
+include <fset.h>
+include "ids.h"
+include <gki.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# create a box test image
+
+procedure t_im()
+
+pointer gp
+char device[SZ_FNAME]
+
+pointer gopen()
+int dd[LEN_GKIDD]
+
+short i,data[DIM+1]
+short set_image[6]
+int key, j
+real x[30],y[30]
+real lb,ub,mid
+int mod()
+
+begin
+ call clgstr("device", device, SZ_FNAME)
+ call ids_open (device, dd)
+ call gki_inline_kernel (STDIMAGE, dd)
+ gp = gopen ( device, NEW_FILE, STDIMAGE)
+
+ call fseti (STDIMAGE, F_TYPE, SPOOL_FILE)
+ call fseti (STDIMAGE, F_CANCEL, OK)
+
+ # enable the blue plane
+ set_image[1] = IDS_ON
+ set_image[2] = IDS_EOD # all graphics frames
+ set_image[3] = IDS_BLUE # color
+ set_image[4] = IDS_EOD
+ set_image[5] = IDS_EOD # all quadrants
+ call gescape ( gp, IDS_DISPLAY_G, set_image, 5)
+
+ # set which plane to write into
+ set_image[1] = 1
+ set_image[2] = IDS_EOD # first graphics frame
+ set_image[3] = IDS_BLUE # color
+ set_image[4] = IDS_EOD
+ call gescape ( gp, IDS_SET_GP, set_image, 4)
+
+ # now set up boxes
+ lb = 0.0
+ ub = 1.0
+ mid = (lb + ub)/2.
+ for ( i = 1; i <= 5 ; i = i + 1 ) {
+ if ( mod(i-1,2) == 0 ) {
+ x[1] = lb
+ y[1] = mid
+ x[2] = mid
+ y[2] = ub
+ x[3] = ub
+ y[3] = mid
+ x[4] = mid
+ y[4] = lb
+ x[5] = lb
+ y[5] = mid
+ } else {
+ x[1] = (mid-lb)/2 + lb
+ y[1] = x[1]
+ x[2] = x[1]
+ y[2] = y[1] + mid - lb
+ x[3] = y[2]
+ y[3] = y[2]
+ x[4] = y[2]
+ y[4] = x[1]
+ x[5] = x[1]
+ y[5] = y[1]
+ lb = x[1]
+ ub = y[2]
+ }
+ do j = 1,5 {
+ x[j] = x[j] * 32768. / 32767.
+ if (x[j] > 1.0)
+ x[j] = 1.0
+ y[j] = y[j] * 32768. / 32767.
+ if (y[j] > 1.0)
+ y[j] = 1.0
+ }
+ call gpline ( gp, x, y, 5)
+ }
+
+ # all done
+ call gclose ( gp )
+ call ids_close
+end
diff --git a/pkg/images/tv/iis/ids/testcode/crin.x b/pkg/images/tv/iis/ids/testcode/crin.x
new file mode 100644
index 00000000..c9d27279
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/crin.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fio.h>
+include <fset.h>
+include "ids.h"
+include <gki.h>
+include <gset.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# zoom
+
+procedure t_im()
+
+pointer gp
+char device[SZ_FNAME]
+
+pointer gopen()
+int dd[LEN_GKIDD]
+
+short i, data[DIM+1]
+int key, but, fnum
+real x, y
+real xjunk, yjunk
+
+begin
+ call clgstr("device", device, SZ_FNAME)
+ call ids_open (device, dd)
+ call gki_inline_kernel (STDIMAGE, dd)
+ gp = gopen ( device, NEW_FILE, STDIMAGE)
+
+ call fseti (STDIMAGE, F_TYPE, SPOOL_FILE)
+ call fseti (STDIMAGE, F_CANCEL, OK)
+ call ids_grstream (STDIMAGE)
+
+ # read first to clear box
+ call gseti(gp, G_CURSOR, IDS_BUT_RD)
+ call ggcur(gp, xjunk, yjunk, key)
+
+ i = 1
+ repeat {
+ call eprintf("set zoom and zoom center\n")
+ call gseti (gp, G_CURSOR, IDS_BUT_WT)
+ call ggcur(gp, x, y, but)
+ call gseti (gp, G_CURSOR, 1)
+ call ggcur(gp, x, y, key)
+ call zm(gp, but, x, y)
+ call eprintf("set frame, 4 to exit\n")
+ call gseti (gp, G_CURSOR, IDS_BUT_WT)
+ call ggcur(gp, xjunk, yjunk, fnum)
+ if ( fnum == 4)
+ break
+ call iset(gp, fnum)
+ repeat {
+ call gseti (gp, G_CURSOR, IDS_BUT_WT)
+ call ggcur(gp, xjunk, yjunk, but)
+ call gseti (gp, G_CURSOR, fnum)
+ call rpc(gp, x, y, key)
+ call ggcell (gp, data, 1, 1, x, y, x, y)
+ call eprintf("frame %d, datum: %d\n")
+ call pargi (fnum)
+ call pargs (data[1])
+ } until ( but == 4)
+ } until ( i == 0 )
+
+
+ # all done
+ call gclose ( gp )
+ call ids_close
+end
+
+# rpcursor --- read and print cursor
+
+procedure rpc(gp, sx, sy, key)
+
+pointer gp
+real sx,sy
+int key
+
+begin
+ call ggcur (gp, sx, sy, key)
+ call eprintf("cursor: (%f,%f) (%d,%d) key %d\n")
+ call pargr (sx)
+ call pargr (sy)
+ call pargi ( int(sx*32767)/64)
+ call pargi ( int(sy*32767)/64)
+ call pargi (key)
+end
+
+# zoom
+
+procedure zm(gp, pow, x, y)
+
+int pow
+pointer gp
+real x, y
+
+short data[9]
+
+begin
+ data[1] = IDS_ZOOM
+ data[2] = IDS_WRITE
+ data[3] = 3
+ data[4] = IDS_EOD
+ data[5] = IDS_EOD
+ data[6] = 0
+ data[7] = 2**(pow-1)
+ data[8] = x * GKI_MAXNDC
+ data[9] = y * GKI_MAXNDC
+ call gescape ( gp, IDS_CONTROL, data[1], 9)
+end
+
+# set image plane for operation
+
+procedure iset (gp, frame)
+
+int frame
+pointer gp
+
+short data[10]
+
+begin
+ data[1] = frame
+ data[2] = IDS_EOD
+ data[3] = IDS_EOD # all bitplanes
+ call gescape (gp, IDS_SET_IP, data, 3)
+end
diff --git a/pkg/images/tv/iis/ids/testcode/grey.x b/pkg/images/tv/iis/ids/testcode/grey.x
new file mode 100644
index 00000000..a7e16b83
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/grey.x
@@ -0,0 +1,90 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imd.h"
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# create a grey scale test image, using frames 1 and 2, and
+# position the cursor in the upper right quadrant.
+
+procedure t_im()
+
+pointer gp
+char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int fd
+
+pointer gopen()
+bool streq()
+int open()
+
+short i,data[DIM+1]
+short display[6]
+short set_image[3]
+real y, sx, sy
+int key
+
+begin
+ call clgstr("output", output, SZ_FNAME)
+ if (!streq (output, "") ) {
+ call strcpy (output, output_file, SZ_FNAME)
+ fd = open (output_file, NEW_FILE, BINARY_FILE)
+ } else
+ fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE)
+
+ call clgstr("device", device, SZ_FNAME)
+ gp = gopen ( device, NEW_FILE, fd)
+
+ data[1] = IMD_R_HARD
+ call gescape ( gp, IMD_RESET, data, 1)
+ # display all frames off
+ display[1] = IMD_OFF
+ display[2] = IMD_EOD # all frames
+ display[3] = IMD_EOD # all colors
+ display[4] = IMD_EOD # all quads
+ call gescape ( gp, IMD_DISPLAY_I, display, 6)
+ # display frames 1, 2 on -- 1 red, 2 green
+ display[1] = IMD_ON
+ display[2] = 1
+ display[3] = IMD_EOD
+ display[4] = IMD_RED
+ display[5] = IMD_EOD
+ display[6] = IMD_EOD # all quads
+ call gescape ( gp, IMD_DISPLAY_I, display, 6)
+ display[1] = IMD_ON
+ display[2] = 2
+ display[3] = IMD_EOD
+ display[4] = IMD_GREEN
+ display[5] = IMD_EOD
+ display[6] = IMD_EOD # all quads
+ call gescape ( gp, IMD_DISPLAY_I, display, 6)
+
+ # now set up grey scale changing upward in frame 1
+ set_image[1] = 1
+ set_image[2] = IMD_EOD
+ set_image[3] = IMD_EOD # all planes
+ call gescape ( gp, IMD_SET_IP, set_image, 3)
+ for ( i = 1; i <= DIM ; i = i + 1 ) {
+ call amovks ( i-1, data, DIM)
+ y = real(i-1)/(DIM-1)
+ call gpcell ( gp, data, DIM, 1, 0., y, 1., y)
+ }
+
+ # grey scale changing horizontally in frame 2
+ set_image[1] = 2
+ call gescape ( gp, IMD_SET_IP, set_image, 3)
+ do i = 1, DIM
+ data[i] = i
+ call gpcell ( gp, data, DIM, 1, 0., 0., 1., 1.)
+
+ # set the cursor
+ call gscur ( gp, 0.0, 1.0)
+
+ # read cursor
+ # call ggcur( gp, sx, sy, key)
+
+ # all done
+ call gclose ( gp )
+ call close ( fd )
+end
diff --git a/pkg/images/tv/iis/ids/testcode/grin.x b/pkg/images/tv/iis/ids/testcode/grin.x
new file mode 100644
index 00000000..b76e58b2
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/grin.x
@@ -0,0 +1,98 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fio.h>
+include <fset.h>
+include <gki.h>
+include "ids.h"
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# create a grey scale test image, using frames 1 and 2, and
+# position the cursor in the upper right quadrant.
+
+procedure t_im()
+
+pointer gp
+char device[SZ_FNAME]
+
+pointer gopen()
+int open()
+int dd[LEN_GKIDD]
+
+short i,data[DIM+1]
+short display[6]
+short set_image[3]
+real y, sx, sy
+int key
+
+begin
+ call clgstr("device", device, SZ_FNAME)
+ call ids_open (device, dd)
+ call gki_inline_kernel (STDIMAGE, dd)
+ gp = gopen ( device, NEW_FILE, STDIMAGE)
+
+ call fseti (STDIMAGE, F_TYPE, SPOOL_FILE)
+ call fseti (STDIMAGE, F_CANCEL, OK)
+ call ids_grstream(STDIMAGE)
+
+ data[1] = IDS_R_HARD
+ call gescape ( gp, IDS_RESET, data, 1)
+ # display all frames off
+ display[1] = IDS_OFF
+ display[2] = IDS_EOD # all frames
+ display[3] = IDS_EOD # all colors
+ display[4] = IDS_EOD # all quads
+ call gescape ( gp, IDS_DISPLAY_I, display, 6)
+ # display frames 1, 2 on -- 1 red, 2 green
+ display[1] = IDS_ON
+ display[2] = 1
+ display[3] = IDS_EOD
+ display[4] = IDS_RED
+ display[5] = IDS_EOD
+ display[6] = IDS_EOD # all quads
+ call gescape ( gp, IDS_DISPLAY_I, display, 6)
+ display[1] = IDS_ON
+ display[2] = 2
+ display[3] = IDS_EOD
+ display[4] = IDS_GREEN
+ display[5] = IDS_EOD
+ display[6] = IDS_EOD # all quads
+ call gescape ( gp, IDS_DISPLAY_I, display, 6)
+
+ # now set up grey scale changing upward in frame 1
+ set_image[1] = 1
+ set_image[2] = IDS_EOD
+ set_image[3] = IDS_EOD # all planes
+ call gescape ( gp, IDS_SET_IP, set_image, 3)
+ for ( i = 1; i <= DIM ; i = i + 1 ) {
+ call amovks ( i-1, data, DIM)
+ y = real(i-1)/(DIM-1)
+ call gpcell ( gp, data, DIM, 1, 0., y, 1., y)
+ }
+
+ # grey scale changing horizontally in frame 2
+ set_image[1] = 2
+ call gescape ( gp, IDS_SET_IP, set_image, 3)
+ do i = 1, DIM
+ data[i] = i-1
+ call gpcell ( gp, data, DIM, 1, 0., 0., 1., 1.)
+
+ # set the cursor
+ call gscur ( gp, 0.0, 1.0)
+
+ # read cursor
+ call ggcur (gp, sx, sy, key)
+ call eprintf("cursor read as : (%f,%f) (%d,%d), key %d\n")
+ call pargr (sx)
+ call pargr (sy)
+ call pargi ( int(sx*32767)/64)
+ call pargi ( int(sy*32767)/64)
+ call pargi (key)
+
+ # all done
+ call gclose (gp)
+ call ids_close
+end
diff --git a/pkg/images/tv/iis/ids/testcode/scr.x b/pkg/images/tv/iis/ids/testcode/scr.x
new file mode 100644
index 00000000..ec4821cf
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/scr.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imd.h"
+include <gset.h>
+include <gki.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# scroll
+
+procedure t_im()
+
+pointer gp
+char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int fd
+
+pointer gopen()
+bool streq()
+int open()
+common /local/gp
+
+begin
+ call clgstr("output", output, SZ_FNAME)
+ if (!streq (output, "") ) {
+ call strcpy (output, output_file, SZ_FNAME)
+ fd = open (output_file, NEW_FILE, BINARY_FILE)
+ } else
+ fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE)
+
+ call clgstr("device", device, SZ_FNAME)
+ gp = gopen ( device, NEW_FILE, fd)
+
+ call cl_button
+ call scroll(0,0)
+ call cursor(128,128)
+ call wt_button
+ call scroll(128,195)
+ call cursor(128,128)
+ call wt_button
+ call zm(4,128,128)
+ call wt_button
+ call cursor(128,128)
+ call wt_button
+ call zm(1,205,205)
+
+ # all done
+ call gclose ( gp )
+ call close ( fd )
+end
+
+procedure scroll(x,y)
+
+int x,y
+
+pointer gp
+common /local/gp
+short data[8]
+
+begin
+ data[1] = IMD_SCROLL
+ data[2] = IMD_WRITE
+ data[3] = 2
+ data[4] = IMD_EOD
+ data[5] = IMD_EOD
+ data[6] = 0
+ data[7] = (x-1) * MCXSCALE
+ data[8] = (y-1) * MCYSCALE
+ call gescape(gp, IMD_CONTROL, data, 8)
+end
+
+procedure cursor(x,y)
+
+int x,y
+pointer gp
+real xr, yr
+common /local/gp
+
+begin
+ xr = real((x-1)*MCXSCALE)/GKI_MAXNDC
+ yr = real((y-1)*MCXSCALE)/GKI_MAXNDC
+ call gseti(gp, G_CURSOR, 1)
+ call gscur(gp, xr, yr)
+end
+
+procedure wt_button
+
+real x,y
+int key
+pointer gp
+common /local/gp
+begin
+ call gseti(gp, G_CURSOR, IMD_BUT_WT)
+ call ggcur(gp, x, y, key)
+end
+
+procedure cl_button
+
+real x,y
+int key
+pointer gp
+common /local/gp
+
+begin
+ call gseti(gp, G_CURSOR, IMD_BUT_RD)
+ call ggcur(gp, x, y, key)
+end
+
+procedure zm(power, x,y)
+
+int power
+int x,y
+
+short data[9]
+pointer gp
+common /local/gp
+
+begin
+ data[1] = IMD_ZOOM
+ data[2] = IMD_WRITE
+ data[3] = 3
+ data[4] = IMD_EOD
+ data[5] = IMD_EOD
+ data[6] = 0
+ data[7] = power
+ data[8] = (x-1) * MCXSCALE
+ data[9] = (y-1) * MCYSCALE
+ call gescape(gp, IMD_CONTROL, data, 9)
+end
diff --git a/pkg/images/tv/iis/ids/testcode/scrin.x b/pkg/images/tv/iis/ids/testcode/scrin.x
new file mode 100644
index 00000000..7a704fe4
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/scrin.x
@@ -0,0 +1,130 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fio.h>
+include <fset.h>
+include "ids.h"
+include <gset.h>
+include <gki.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# scroll
+
+procedure t_im()
+
+pointer gp
+char device[SZ_FNAME]
+
+pointer gopen()
+int dd[LEN_GKIDD]
+common /local/gp
+
+begin
+ call clgstr("device", device, SZ_FNAME)
+ call ids_open (device, dd)
+ call gki_inline_kernel (STDIMAGE, dd)
+ gp = gopen ( device, NEW_FILE, STDIMAGE)
+
+ call fseti (STDIMAGE, F_TYPE, SPOOL_FILE)
+ call fseti (STDIMAGE, F_CANCEL, OK)
+ call ids_grstream (STDIMAGE)
+
+ call cl_button
+ call scroll(1,1)
+ call cursor(129,129)
+ call wt_button
+ call scroll(129,195)
+ call cursor(129,129)
+ call wt_button
+ call zm(4,129,129)
+ call wt_button
+ call cursor(129,129)
+ call wt_button
+ call zm(1,205,205)
+
+ # all done
+ call gclose ( gp )
+ call ids_close
+end
+
+procedure scroll(x,y)
+
+int x,y
+
+pointer gp
+common /local/gp
+short data[8]
+
+begin
+ data[1] = IDS_SCROLL
+ data[2] = IDS_WRITE
+ data[3] = 2
+ data[4] = IDS_EOD
+ data[5] = IDS_EOD
+ data[6] = 0
+ data[7] = (x-1) * MCXSCALE
+ data[8] = (y-1) * MCYSCALE
+ call gescape(gp, IDS_CONTROL, data, 8)
+end
+
+procedure cursor(x,y)
+
+int x,y
+pointer gp
+real xr, yr
+common /local/gp
+
+begin
+ xr = real((x-1)*MCXSCALE)/GKI_MAXNDC
+ yr = real((y-1)*MCXSCALE)/GKI_MAXNDC
+ call gseti(gp, G_CURSOR, 1)
+ call gscur(gp, xr, yr)
+end
+
+procedure wt_button
+
+real x,y
+int key
+pointer gp
+common /local/gp
+begin
+ call gseti(gp, G_CURSOR, IDS_BUT_WT)
+ call ggcur(gp, x, y, key)
+end
+
+procedure cl_button
+
+real x,y
+int key
+pointer gp
+common /local/gp
+
+begin
+ call gseti(gp, G_CURSOR, IDS_BUT_RD)
+ call ggcur(gp, x, y, key)
+end
+
+procedure zm(power, x,y)
+
+int power
+int x,y
+
+short data[9]
+pointer gp
+common /local/gp
+
+begin
+ data[1] = IDS_ZOOM
+ data[2] = IDS_WRITE
+ data[3] = 3
+ data[4] = IDS_EOD
+ data[5] = IDS_EOD
+ data[6] = 0
+ data[7] = power
+ data[8] = (x-1) * MCXSCALE
+ data[9] = (y-1) * MCYSCALE
+ call gescape(gp, IDS_CONTROL, data, 9)
+end
diff --git a/pkg/images/tv/iis/ids/testcode/sn.x b/pkg/images/tv/iis/ids/testcode/sn.x
new file mode 100644
index 00000000..ebce47c0
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/sn.x
@@ -0,0 +1,192 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fio.h>
+include <fset.h>
+include "ids.h"
+include <gki.h>
+include <gset.h>
+include <imhdr.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# snap
+
+procedure t_im()
+
+pointer gp
+char device[SZ_FNAME]
+char cjunk[SZ_FNAME]
+
+pointer gopen()
+int dd[LEN_GKIDD]
+
+int key, fnum, zfac
+int ps, pe
+real x, y
+real xjunk, yjunk
+int clgeti
+bool image, clgetb
+
+begin
+ call clgstr("device", device, SZ_FNAME)
+ call ids_open (device, dd)
+ call gki_inline_kernel (STDIMAGE, dd)
+ gp = gopen ( device, NEW_FILE, STDIMAGE)
+
+ call fseti (STDIMAGE, F_TYPE, SPOOL_FILE)
+ call fseti (STDIMAGE, F_CANCEL, OK)
+ call ids_grstream (STDIMAGE)
+
+ # read first to clear box
+ call gseti(gp, G_CURSOR, IDS_BUT_RD)
+ call ggcur(gp, xjunk, yjunk, key)
+
+ repeat {
+ if (clgetb ("done?"))
+ break
+
+ zfac = clgeti ("zoom factor")
+
+ call clgstr ("Set zoom center, press <cr>", cjunk, SZ_FNAME)
+ call gseti (gp, G_CURSOR, 1)
+ call ggcur(gp, x, y, key)
+ call zm(gp, zfac, x, y)
+
+ image = clgetb("Do you want a picture?")
+ if (image)
+ call snapi (gp)
+ else {
+ repeat {
+ ps = clgeti ("starting line")
+ if ( ps == -1)
+ break
+ pe = clgeti ("ending line")
+ call snap (gp, ps, pe)
+ }
+ }
+ }
+
+
+ # all done
+ call gclose ( gp )
+ call ids_close
+end
+
+# zoom
+
+procedure zm(gp, pow, x, y)
+
+int pow
+pointer gp
+real x, y
+
+short data[9]
+
+begin
+ data[1] = IDS_ZOOM
+ data[2] = IDS_WRITE
+ data[3] = 3
+ data[4] = IDS_EOD
+ data[5] = IDS_EOD
+ data[6] = 0
+ data[7] = 2**(pow-1)
+ data[8] = x * GKI_MAXNDC
+ data[9] = y * GKI_MAXNDC
+ call gescape ( gp, IDS_CONTROL, data[1], 9)
+end
+
+procedure snap (gp, ps, pe)
+
+pointer gp
+int ps, pe
+
+real y
+short data[7]
+pointer sp
+pointer sndata
+int i,j
+
+begin
+ call smark (sp)
+ data[1] = IDS_SNAP
+ data[2] = IDS_WRITE
+ data[3] = 1
+ data[4] = IDS_EOD
+ data[5] = IDS_EOD
+ data[6] = 0
+ data[7] = IDS_SNAP_RGB
+ call gescape (gp, IDS_CONTROL, data, 7)
+
+ if (pe < ps) {
+ call eprintf("Can't handle ending position < start \n")
+ return
+ }
+
+ call salloc ( sndata, DIM, TY_SHORT)
+ call eprintf ("snapping from %d through %d\n")
+ call pargi (ps)
+ call pargi (pe)
+ call eprintf ("data values 0-5 255 256 511\n")
+ do i = ps, pe {
+ y = real(i)*MCYSCALE / GKI_MAXNDC.
+ call ggcell (gp, Mems[sndata], DIM, 1, 0.0, y, 1.0, y)
+ call eprintf ("r%3d data:")
+ call pargi (i)
+ call eprintf (" %5d %5d %5d %5d %5d %5d %5d %5d %5d\n")
+ do j = 0, 5
+ call pargs (Mems[sndata+j])
+ call pargs (Mems[sndata+255])
+ call pargs (Mems[sndata+256])
+ call pargs (Mems[sndata+511])
+ }
+
+ data[1] = IDS_R_SNAPDONE
+ call gescape (gp, IDS_RESET, data, 1)
+
+ call sfree (sp)
+end
+
+procedure snapi (gp)
+
+pointer gp
+
+real y
+short data[7]
+pointer im, immap(), impl2s()
+char fname[SZ_FNAME]
+int i
+
+begin
+ call clgstr ("file", fname, SZ_FNAME)
+ im = immap(fname, NEW_FILE, 0)
+ IM_PIXTYPE(im) = TY_SHORT
+ IM_LEN(im,1) = DIM
+ IM_LEN(im,2) = DIM
+
+ data[1] = IDS_SNAP
+ data[2] = IDS_WRITE
+ data[3] = 1
+ data[4] = IDS_EOD
+ data[5] = IDS_EOD
+ data[6] = 0
+ data[7] = IDS_SNAP_RGB
+ call gescape (gp, IDS_CONTROL, data, 7)
+
+ do i = 0, 511 {
+ if ( mod(i,52) == 0) {
+ call eprintf ("%d ")
+ call pargi (100*i/DIM)
+ call flush (STDERR)
+ }
+ y = real(i)*MCYSCALE / GKI_MAXNDC.
+ call ggcell (gp, Mems[impl2s(im,i+1)], 512, 1, 0.0, y, 1.0, y)
+ }
+ call eprintf ("\n")
+
+ call imunmap(im)
+ data[1] = IDS_R_SNAPDONE
+ call gescape (gp, IDS_RESET, data, 1)
+end
diff --git a/pkg/images/tv/iis/ids/testcode/t_giis.x b/pkg/images/tv/iis/ids/testcode/t_giis.x
new file mode 100644
index 00000000..601bc17b
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/t_giis.x
@@ -0,0 +1,67 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <gki.h>
+
+# GIIS -- Graphics kernel for image output to the IIS.
+# The whole package is copied as much as possible from the stdgraph package.
+
+procedure t_giis()
+
+int fd, list
+pointer gki, sp, fname, devname
+int dev[LEN_GKIDD], deb[LEN_GKIDD]
+int debug, verbose, gkiunits
+bool clgetb()
+int clpopni(), clgfil(), open(), btoi()
+int gki_fetch_next_instruction()
+
+begin
+ call smark (sp)
+ call salloc (fname, SZ_FNAME, TY_CHAR)
+ call salloc (devname, SZ_FNAME, TY_CHAR)
+
+ # Open list of metafiles to be decoded.
+ list = clpopni ("input")
+
+ # Get parameters.
+ call clgstr ("device", Memc[devname], SZ_FNAME)
+ if (clgetb ("generic")) {
+ debug = NO
+ verbose = NO
+ gkiunits = NO
+ } else {
+ debug = btoi (clgetb ("debug"))
+ verbose = btoi (clgetb ("verbose"))
+ gkiunits = btoi (clgetb ("gkiunits"))
+ }
+
+ # Open the graphics kernel.
+ call ids_open (Memc[devname], dev)
+ call gkp_install (deb, STDERR, verbose, gkiunits)
+
+ # Process a list of metacode files, writing the decoded metacode
+ # instructions on the standard output.
+
+ while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) {
+ # Open input file.
+ iferr (fd = open (Memc[fname], READ_ONLY, BINARY_FILE)) {
+ call erract (EA_WARN)
+ next
+ }
+
+ # Process the metacode instruction stream.
+ while (gki_fetch_next_instruction (fd, gki) != EOF) {
+ if (debug == YES)
+ call gki_execute (Mems[gki], deb)
+ call gki_execute (Mems[gki], dev)
+ }
+
+ call close (fd)
+ }
+
+ call gkp_close()
+ call ids_close()
+ call clpcls (list)
+ call sfree (sp)
+end
diff --git a/pkg/images/tv/iis/ids/testcode/zm.x b/pkg/images/tv/iis/ids/testcode/zm.x
new file mode 100644
index 00000000..dff01cbe
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/zm.x
@@ -0,0 +1,64 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "imd.h"
+include <gki.h>
+include <gset.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# zoom
+
+procedure t_im()
+
+pointer gp
+char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int fd
+
+pointer gopen()
+bool streq()
+int open()
+
+short i,data[DIM+1]
+short set_image[6]
+int key
+real x[30],y[30]
+int xjunk, yjunk
+
+begin
+ call clgstr("output", output, SZ_FNAME)
+ if (!streq (output, "") ) {
+ call strcpy (output, output_file, SZ_FNAME)
+ fd = open (output_file, NEW_FILE, BINARY_FILE)
+ } else
+ fd = open ("dev$stdimage", NEW_FILE, BINARY_FILE)
+
+ call clgstr("device", device, SZ_FNAME)
+ gp = gopen ( device, NEW_FILE, fd)
+
+ # now zoom after reading button presses
+ # read first to clear box
+ call gseti(gp, G_CURSOR, IMD_BUT_RD)
+ call ggcur(gp, xjunk, yjunk, key)
+
+ for ( i = 1 ; i < 5 ; i = i + 1) {
+ call gseti(gp, G_CURSOR, IMD_BUT_WT)
+ call ggcur(gp, xjunk, yjunk, key)
+
+ data[11] = IMD_ZOOM
+ data[12] = IMD_WRITE
+ data[13] = 3
+ data[14] = IMD_EOD
+ data[15] = IMD_EOD
+ data[16] = 0
+ data[17] = 4
+ data[18] = (((i-1)* 128)-1) * MCXSCALE
+ data[19] = (((i-1)* 128)-1) * MCYSCALE
+ call gescape ( gp, IMD_CONTROL, data[11], 9)
+ }
+
+ # all done
+ call gclose ( gp )
+ call close ( fd )
+end
diff --git a/pkg/images/tv/iis/ids/testcode/zmin.x b/pkg/images/tv/iis/ids/testcode/zmin.x
new file mode 100644
index 00000000..676a72f0
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/zmin.x
@@ -0,0 +1,84 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <error.h>
+include <fio.h>
+include <fset.h>
+include "ids.h"
+include <gki.h>
+include <gset.h>
+
+define DIM 512
+define MCXSCALE 64
+define MCYSCALE 64
+
+# zoom
+
+procedure t_im()
+
+pointer gp
+char device[SZ_FNAME]
+
+pointer gopen()
+int dd[LEN_GKIDD]
+
+short i,data[DIM+1]
+short set_image[6]
+int key
+real x[30],y[30]
+real xjunk, yjunk
+
+begin
+ call clgstr("device", device, SZ_FNAME)
+ call ids_open (device, dd)
+ call gki_inline_kernel (STDIMAGE, dd)
+ gp = gopen ( device, NEW_FILE, STDIMAGE)
+
+ call fseti (STDIMAGE, F_TYPE, SPOOL_FILE)
+ call fseti (STDIMAGE, F_CANCEL, OK)
+ call ids_grstream (STDIMAGE)
+
+ # now zoom after reading button presses
+ # read first to clear box
+ call gseti(gp, G_CURSOR, IDS_BUT_RD)
+ call ggcur(gp, xjunk, yjunk, key)
+
+ for ( i = 1 ; i < 5 ; i = i + 1) {
+ call gseti (gp, G_CURSOR, IDS_BUT_WT)
+ call ggcur(gp, xjunk, yjunk, key)
+ call gseti (gp, G_CURSOR, 1)
+ call rpc(gp, xjunk, yjunk, key)
+
+ data[11] = IDS_ZOOM
+ data[12] = IDS_WRITE
+ data[13] = 3
+ data[14] = IDS_EOD
+ data[15] = IDS_EOD
+ data[16] = 0
+ data[17] = 4
+ data[18] = min(((i-1)* 128) * MCXSCALE, GKI_MAXNDC)
+ data[19] = min(((i-1)* 128) * MCYSCALE, GKI_MAXNDC)
+ call gescape ( gp, IDS_CONTROL, data[11], 9)
+ }
+
+ # all done
+ call gclose ( gp )
+ call ids_close
+end
+
+# rpcursor --- read and print cursor
+
+procedure rpc(gp, sx, sy, key)
+
+pointer gp
+real sx,sy
+int key
+
+begin
+ call ggcur (gp, sx, sy, key)
+ call eprintf("cursor: (%f,%f) (%d,%d) key %d\n")
+ call pargr (sx)
+ call pargr (sy)
+ call pargi ( int(sx*32767)/64)
+ call pargi ( int(sy*32767)/64)
+ call pargi (key)
+end
diff --git a/pkg/images/tv/iis/ids/testcode/zztest.x b/pkg/images/tv/iis/ids/testcode/zztest.x
new file mode 100644
index 00000000..599b7103
--- /dev/null
+++ b/pkg/images/tv/iis/ids/testcode/zztest.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <fset.h>
+include <gset.h>
+
+define XS 0.216
+define XE 0.719
+define YS 0.214
+define YE 0.929
+
+task test = t_test
+
+# T_TEST -- Test program for graphics plotting. A labelled grid is output.
+
+procedure t_test ()
+
+bool redir
+pointer sp, gp
+char command[SZ_LINE], image[SZ_FNAME], word[SZ_LINE]
+char output[SZ_FNAME], output_file[SZ_FNAME], device[SZ_FNAME]
+int cmd, input_fd, stat, fd
+
+pointer gopen()
+bool streq()
+int fstati(), open(), getline()
+
+begin
+ # If the input has been redirected, input is read from the named
+ # command file. If not, each image name in the input template is
+ # plotted.
+
+ if (fstati (STDIN, F_REDIR) == YES) {
+call eprintf ("Input has been redirected\n")
+ redir = true
+ cmd = open (STDIN, READ_ONLY, TEXT_FILE)
+ }
+
+ # Loop over commands until EOF
+ repeat {
+ if (redir) {
+ if (getline (STDIN, command, SZ_LINE) == EOF)
+ break
+ call sscan (command)
+ call gargwrd (word, SZ_LINE)
+ if (!streq (word, "plot")) {
+ # Pixel window has been stored as WCS 2
+ call gseti (gp, G_WCS, 2)
+ call gscan (command)
+ next
+ } else
+ call gargwrd (image)
+ }
+
+ call clgstr ("output", output, SZ_FNAME)
+ if (!streq (output, "")) {
+ call strcpy (output, output_file, SZ_FNAME)
+ fd = open (output_file, NEW_FILE, BINARY_FILE)
+ } else
+ fd = open ("dev$crt", NEW_FILE, BINARY_FILE)
+
+ call clgstr ("device", device, SZ_FNAME)
+ gp = gopen (device, NEW_FILE, fd)
+
+ call gseti (gp, G_XDRAWGRID, 1)
+ call gseti (gp, G_YDRAWGRID, 1)
+ call gseti (gp, G_NMAJOR, 21)
+ call glabax (gp, "TEST", "NDC_X", "NDC_Y")
+ call gline (gp, XS, YS, XE, YS)
+ call gline (gp, XE, YS, XE, YE)
+ call gline (gp, XE, YE, XS, YE)
+ call gline (gp, XS, YE, XS, YS)
+ call gmark (gp, 0.5, 0.5, GM_CROSS, 3.0, 3.0)
+ call gtext (gp, XS, YS-0.1, "DICOMED crtpict film area")
+ call gclose (gp)
+ call close (fd)
+ }
+
+ call clpcls (input_fd)
+ call sfree (sp)
+end
generated by cgit (git 2.34.1) at 2025-09-20 15:04:00 -0400