{{{  Test standalone programs

This is a text file listing of the demonstration programs. The file is
provided so that non-TDS3 and non-occam toolset users may inspect the source.

===============================================================================
{{{  PROGRAM Open Text window demo
{{{F 
--:::F esonne00.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow00.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    VAL INT32 stream.id IS SPID.STDOUT:
    BYTE isv.result, result:
    INT32 stream.id1:
    INT32 stream.id2:
    [4]INT16 rect, rect2:
     
    SEQ
      isv.result := SPR.OK
      result     := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Multiple text window demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "==================================")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, " ")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demonstration will open two text windows and print in them.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "It demonstrates the use of PROC open.text.window.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, " ")
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, " ")
       
    
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "At start up.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Open window 1
      open.text.window (from.isv, to.isv, "Window 1",
                           100, 100, 20, 10, 10, 20,
                           NO.ACTIVATE.TEXT.WIN.STYLE \/ NO.TITLE.TEXT.WIN.STYLE,
                           0, 100,
                           stream.id1, result, rect)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open text window one.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Open window 2
      open.text.window (from.isv, to.isv, "Window 2",
                           (INT rect[2]) + 0, 100, 40, 20, 7, 14,
                           NO.ACTIVATE.TEXT.WIN.STYLE,
                           0, 100,
                           stream.id2, result, rect2)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open text window two.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Print things in windows until key pressed
      BOOL running:
      SEQ
        {{{  Print press a key to stop
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press a key to stop the printing")
         
        running := TRUE
        WHILE running
          SEQ
            write.string (from.isv, to.isv, stream.id1, isv.result, "Window 1--- ")
            write.string (from.isv, to.isv, stream.id2, isv.result, "Window two--- ")
            {{{  Poll for a key
            INT items.left.in.buffer:
            BYTE ascii.key.code:
            SEQ
              get.key (from.isv, to.isv, stream.id, items.left.in.buffer, ascii.key.code, isv.result)
              running := (items.left.in.buffer = (-1)) AND (isv.result = SPR.OK)
             
       
      {{{  Wait for a key
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
       
    
      close.stream (from.isv, to.isv, stream.id1, result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close text window one.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      close.stream (from.isv, to.isv, stream.id2, result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close text window two.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow00.dcd
...F descriptor
--:::F xhcsow00.dds
...F link
--:::F xhcsow00.dlk
...F debug
--:::F xhcsow00.ddb
...F CODE SC code
--:::F xhcsow00.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne00.dcd
...F descriptor
--:::F esonne00.dds
...F CODE PROGRAM Open Text window demo
--:::F esonne00.cpr
 
===============================================================================
{{{  PROGRAM Free resources demo
{{{F 
--:::F esonne01.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow01.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL  INT32 stream.id IS SPID.STDOUT:
    BYTE isv.result, result:
    INT  max.packet.size.to.server:
    INT  max.packet.size.from.server:
    INT  no.of.free.file.handles:
    INT  no.of.free.text.windows:
    INT  no.of.free.dll.indexes:
     
    SEQ
      isv.result := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Free resources demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "============================")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demo will print the free resources currently availiable.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "It demonstrates the use of PROC get.free.resources.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "At start up.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      result := isv.result
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
    
      get.free.resources (from.isv, to.isv,
                          max.packet.size.to.server,
                          max.packet.size.from.server,
                          no.of.free.file.handles,
                          no.of.free.text.windows,
                          no.of.free.dll.indexes,
                          isv.result)
    
      {{{  Write the results
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "After get.free.resources")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result                          = ")
      result := isv.result
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      
      write.string    (from.isv, to.isv, stream.id, isv.result, "maximum packet size to server   = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, max.packet.size.to.server, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      
      write.string    (from.isv, to.isv, stream.id, isv.result, "maximum packet size from server = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, max.packet.size.from.server, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      
      write.string    (from.isv, to.isv, stream.id, isv.result, "number of free file handles     = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, no.of.free.file.handles, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      
      write.string    (from.isv, to.isv, stream.id, isv.result, "number of free text windows     = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, no.of.free.text.windows, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      
      write.string    (from.isv, to.isv, stream.id, isv.result, "number of free DLL indexes      = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, no.of.free.dll.indexes, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow01.dcd
...F descriptor
--:::F xhcsow01.dds
...F link
--:::F xhcsow01.dlk
...F debug
--:::F xhcsow01.ddb
...F CODE SC code
--:::F xhcsow01.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne01.dcd
...F descriptor
--:::F esonne01.dds
...F CODE PROGRAM Free resources demo
--:::F esonne01.cpr
 
===============================================================================
{{{  PROGRAM System information demo
{{{F 
--:::F esonne02.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow02.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL  INT32 stream.id IS SPID.STDOUT:
    BYTE isv.result, result:
    INT16 system.info.result:
     
    SEQ
      isv.result := SPR.OK
      result     := SPR.OK
      {{{  Introduction
      write.string.nl  (from.isv, to.isv, stream.id, isv.result, "System information demonstration")
      write.string.nl  (from.isv, to.isv, stream.id, isv.result, "================================")
      write.nl         (from.isv, to.isv, stream.id, isv.result)
      write.string.nl  (from.isv, to.isv, stream.id, isv.result, "This demonstration will print the windows handle of the desktop window and")
      write.string.nl  (from.isv, to.isv, stream.id, isv.result, "the window that currently has the input focus.")
      write.string.nl  (from.isv, to.isv, stream.id, isv.result, "It demonstrates the use of PROC get.system.information.")
      write.nl         (from.isv, to.isv, stream.id, isv.result)
      wait.any.event   (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "At start up.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Desktop window handle
      get.system.information (from.isv, to.isv, INFO.SYSTEM.DESKTOP,
                              system.info.result, result)
      write.string (from.isv, to.isv, stream.id, isv.result, "Desktop window handle = ")
      write.int    (from.isv, to.isv, stream.id, isv.result, INT system.info.result, 4)
      write.nl     (from.isv, to.isv, stream.id, isv.result)
      wait.any.event   (from.isv, to.isv, stream.id, isv.result)
      write.nl     (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Active window
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Program will pause for three seconds so that you may make another window active")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "and the program will display its window handle.")
      {{{  Pause
      INT start.time:
      TIMER clock:
      SEQ
        clock ? start.time
        clock ? AFTER (start.time PLUS 45000)
       
      get.system.information (from.isv, to.isv, INFO.SYSTEM.ACTIVE.WINDOW,
                              system.info.result, result)
      write.string (from.isv, to.isv, stream.id, isv.result, "Active window handle = ")
      write.int    (from.isv, to.isv, stream.id, isv.result, INT system.info.result, 4)
      write.nl     (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Show other info codes
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Other information codes used with this procedure are: ")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "VAL INT16 INFO.SYSTEM.DESKTOP        IS 0 (INT16):")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "VAL INT16 INFO.SYSTEM.ACTIVE.WINDOW  IS 1 (INT16):")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "VAL INT16 INFO.SYSTEM.CAPTURE.WINDOW IS 2 (INT16):")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "VAL INT16 INFO.SYSTEM.MODAL.WINDOW   IS 3 (INT16):")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "VAL INT16 INFO.SYSTEM.VERSION        IS 4 (INT16):")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow02.dcd
...F descriptor
--:::F xhcsow02.dds
...F link
--:::F xhcsow02.dlk
...F debug
--:::F xhcsow02.ddb
...F CODE SC code
--:::F xhcsow02.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne02.dcd
...F descriptor
--:::F esonne02.dds
...F CODE PROGRAM System information
--:::F esonne02.cpr
 
===============================================================================
{{{  PROGRAM System metric demo
{{{F 
--:::F esonne03.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow03.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL INT32 stream.id IS SPID.STDOUT:
    BYTE      isv.result, result:
    INT16     system.metric.result:
     
    SEQ
      isv.result := SPR.OK
      result     := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "System metric demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "===========================")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demonstration prints the screen resolution using PROC get.system.metric.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Write screen resolution
      get.system.metric (from.isv, to.isv, SM.CXSCREEN,
                         system.metric.result, result)
      write.string (from.isv, to.isv, stream.id, isv.result, "Screen X resolution = ")
      write.int    (from.isv, to.isv, stream.id, isv.result, INT system.metric.result, 4)
      write.nl     (from.isv, to.isv, stream.id, isv.result)
      
      get.system.metric (from.isv, to.isv, SM.CYSCREEN,
                         system.metric.result, result)
      write.string (from.isv, to.isv, stream.id, isv.result, "Screen Y resolution = ")
      write.int    (from.isv, to.isv, stream.id, isv.result, INT system.metric.result, 4)
      write.nl     (from.isv, to.isv, stream.id, isv.result)
      
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "At Finish")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow03.dcd
...F descriptor
--:::F xhcsow03.dds
...F link
--:::F xhcsow03.dlk
...F debug
--:::F xhcsow03.ddb
...F CODE SC code
--:::F xhcsow03.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne03.dcd
...F descriptor
--:::F esonne03.dds
...F CODE PROGRAM System metric demo
--:::F esonne03.cpr
 
===============================================================================
{{{  PROGRAM Window handle and text title demo
{{{F 
--:::F esonne04.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow04.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL INT32 stream.id IS SPID.STDOUT:
    BYTE     isv.result, result:
    INT16    len:
    INT32    stream.id1:
    INT32    stream.id2:
    [4]INT16 rect, rect2:
     
    SEQ
      isv.result := SPR.OK
      result     := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window handle and title demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "=====================================")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demonstration will open two text windows, get the windows handle for")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "those windows, get the window title of the windows and swap the titles.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "It demostrates the procedures PROC get.window.handle, PROC get.window.text and")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "PROC set.window.text.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "At start up.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Open window 1
      open.text.window (from.isv, to.isv, "Window 1",
                           100, 100, 20, 10, 10, 20,
                           NO.ACTIVATE.TEXT.WIN.STYLE,
                           0, 100,
                           stream.id1, result, rect)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open text window one.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Open window 2
      open.text.window (from.isv, to.isv, "Window 2",
                           (INT rect[2]) + 0, 100, 40, 20, 7, 14,
                           NO.ACTIVATE.TEXT.WIN.STYLE,
                           0, 100,
                           stream.id2, result, rect2)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open text window two.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Print info about the windows
      INT16 handle1, handle2:
      [MAX.PACKET.SIZE]BYTE title1, title2:
      INT title1.len, title2.len:
      SEQ
        {{{  Print the window handles
        get.window.handle (from.isv, to.isv, stream.id1, handle1, result)
        get.window.handle (from.isv, to.isv, stream.id2, handle2, result)
        
        write.string    (from.isv, to.isv, stream.id, isv.result, "Window one handle is ")
        write.int       (from.isv, to.isv, stream.id, isv.result, INT handle1, 4)
        write.nl        (from.isv, to.isv, stream.id, isv.result)
        write.string    (from.isv, to.isv, stream.id, isv.result, "Window two handle is ")
        write.int       (from.isv, to.isv, stream.id, isv.result, INT handle2, 4)
        write.nl        (from.isv, to.isv, stream.id, isv.result)
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press a key to continue")
        
        wait.any.event (from.isv, to.isv, stream.id, isv.result)
         
        {{{  Print the window titles
        get.window.text (from.isv, to.isv, handle1, title1, title1.len, result)
        get.window.text (from.isv, to.isv, handle2, title2, title2.len, result)
        
        write.string    (from.isv, to.isv, stream.id, isv.result, "Window one handle is `")
        write.string    (from.isv, to.isv, stream.id, isv.result, [title1 FROM 0 FOR title1.len])
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "`")
        write.string    (from.isv, to.isv, stream.id, isv.result, "Window two handle is `")
        write.string    (from.isv, to.isv, stream.id, isv.result, [title2 FROM 0 FOR title2.len])
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "`")
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press a key to continue")
        
        wait.any.event (from.isv, to.isv, stream.id, isv.result)
         
        {{{  Swap the window titles
        set.window.text (from.isv, to.isv, handle1, [title2 FROM 0 FOR title2.len], result)
        set.window.text (from.isv, to.isv, handle2, [title1 FROM 0 FOR title1.len], result)
        
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window titles have been swapped")
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press a key to continue")
        wait.any.event (from.isv, to.isv, stream.id, isv.result)
         
       
    
      close.stream (from.isv, to.isv, stream.id1, result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close text window one.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
      close.stream (from.isv, to.isv, stream.id2, result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close text window two.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow04.dcd
...F descriptor
--:::F xhcsow04.dds
...F link
--:::F xhcsow04.dlk
...F debug
--:::F xhcsow04.ddb
...F CODE SC code
--:::F xhcsow04.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne04.dcd
...F descriptor
--:::F esonne04.dds
...F CODE PROGRAM Window handle and text title demo
--:::F esonne04.cpr
 
===============================================================================
{{{  PROGRAM Window state demo
{{{F 
--:::F esonne05.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow05.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL INT32 stream.id IS SPID.STDOUT:
    BYTE  isv.result, result:
    INT16 active.window.handle:
     
    SEQ
      isv.result := SPR.OK
      result     := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window state demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "==========================")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demonstration will ask you to pick a window. It will then repeatedly")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "print information about the window until SPACE is pressed.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "It demonstrates the procedure PROC get.window.state.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Get active window
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Program will pause for three seconds so that you may make another window active")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "and the program will display its window handle.")
      {{{  Pause
      INT start.time:
      TIMER clock:
      SEQ
        clock ? start.time
        clock ? AFTER (start.time PLUS 45000)
       
      get.system.information (from.isv, to.isv, INFO.SYSTEM.ACTIVE.WINDOW,
                              active.window.handle, result)
      
      write.string (from.isv, to.isv, stream.id, isv.result, "Active window handle = ")
      write.int    (from.isv, to.isv, stream.id, isv.result, INT active.window.handle, 4)
      write.nl     (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Print state info about the window
      BYTE icon.state, maximized.state, visible.state:
      INT16 parent.window.handle:
      [4]INT bounding.rectangle, client.rectangle:
      BOOL running:
      SEQ
        running := TRUE
        WHILE running
          SEQ
            get.window.state (from.isv, to.isv, active.window.handle,
                              icon.state, maximized.state, visible.state,
                              parent.window.handle,
                              bounding.rectangle, client.rectangle,
                              result)
            {{{  Is the window an icon
            IF
              icon.state = 0 (BYTE)
                write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window is not an icon.")
              TRUE
                write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window is an icon.")
             
            {{{  Is the window maximized
            IF
              maximized.state = 0 (BYTE)
                write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window is not maximized.")
              TRUE
                write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window is maximized.")
             
            {{{  Is the window visible
            IF
              visible.state = 0 (BYTE)
                write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window is not visible.")
              TRUE
                write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window is visible.")
             
            {{{  Print the parent window handle
            write.string (from.isv, to.isv, stream.id, isv.result, "Parent window handle = ")
            write.int    (from.isv, to.isv, stream.id, isv.result, INT parent.window.handle, 5)
            write.nl     (from.isv, to.isv, stream.id, isv.result)
             
            {{{  Print bounding rectangle
            write.string (from.isv, to.isv, stream.id, isv.result, "Bounding co-ords   left=")
            write.int    (from.isv, to.isv, stream.id, isv.result, bounding.rectangle[0], 5)
            write.string (from.isv, to.isv, stream.id, isv.result, "   top=")
            write.int    (from.isv, to.isv, stream.id, isv.result, bounding.rectangle[1], 5)
            write.string (from.isv, to.isv, stream.id, isv.result, "   right=")
            write.int    (from.isv, to.isv, stream.id, isv.result, bounding.rectangle[2], 5)
            write.string (from.isv, to.isv, stream.id, isv.result, "   bottom=")
            write.int    (from.isv, to.isv, stream.id, isv.result, bounding.rectangle[3], 5)
            write.nl     (from.isv, to.isv, stream.id, isv.result)
             
            {{{  Print client rectangle
            write.string (from.isv, to.isv, stream.id, isv.result, "Client co-ords     left=")
            write.int    (from.isv, to.isv, stream.id, isv.result, client.rectangle[0], 5)
            write.string (from.isv, to.isv, stream.id, isv.result, "   top=")
            write.int    (from.isv, to.isv, stream.id, isv.result, client.rectangle[1], 5)
            write.string (from.isv, to.isv, stream.id, isv.result, "   right=")
            write.int    (from.isv, to.isv, stream.id, isv.result, client.rectangle[2], 5)
            write.string (from.isv, to.isv, stream.id, isv.result, "   bottom=")
            write.int    (from.isv, to.isv, stream.id, isv.result, client.rectangle[3], 5)
            write.nl     (from.isv, to.isv, stream.id, isv.result)
             
            write.nl (from.isv, to.isv, stream.id, isv.result)
            write.nl (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE ascii.key.code, result:
            TIMER clock:
            INT start.time, current.time:
            INT items.left.in.buffer:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE ((current.time MINUS start.time) < 45000) AND running
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer,
                           ascii.key.code, isv.result)
                  running := ((isv.result = SPR.OK) AND (items.left.in.buffer = (-1)))
                  clock ? current.time
            
             
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow05.dcd
...F descriptor
--:::F xhcsow05.dds
...F link
--:::F xhcsow05.dlk
...F debug
--:::F xhcsow05.ddb
...F CODE SC code
--:::F xhcsow05.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne05.dcd
...F descriptor
--:::F esonne05.dds
...F CODE PROGRAM Window state demo
--:::F esonne05.cpr
 
===============================================================================
{{{  PROGRAM Window show demo
{{{F 
--:::F esonne06.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow06.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL INT32 stream.id IS SPID.STDOUT:
    BYTE  isv.result:
    INT16 active.window.handle:
     
    SEQ
      isv.result := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Window show demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "=========================")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demonstration will ask you to pick a window. It will then cycle through")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "all the possible *'show window*' modes until SPACE is pressed.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "It demonstrates the use of the procedure PROC show.window.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Get active window
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Program will pause for three seconds so that you may make another window active")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "and the program will display its window handle.")
      {{{  Pause
      INT start.time:
      TIMER clock:
      SEQ
        clock ? start.time
        clock ? AFTER (start.time PLUS 45000)
       
      get.system.information (from.isv, to.isv, INFO.SYSTEM.ACTIVE.WINDOW,
                              active.window.handle, isv.result)
      write.string    (from.isv, to.isv, stream.id, isv.result, "Active window handle = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT active.window.handle, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press SPACE to quit.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Cycle through show window
      BYTE icon.state, maximized.state, visible.state:
      INT16 parent.window.handle:
      [4]INT bounding.rectangle, client.rectangle:
      BOOL running:
      SEQ
        running := TRUE
        WHILE running
          SEQ
            {{{  SW.HIDE
            show.window (from.isv, to.isv, active.window.handle,
                         SW.HIDE, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.HIDE")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
            {{{  SW.MINIMIZE
            show.window (from.isv, to.isv, active.window.handle,
                         SW.MINIMIZE, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.MINIMIZE")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
            {{{  SW.SHOW.MAXIMIZED
            show.window (from.isv, to.isv, active.window.handle,
                         SW.SHOW.MAXIMIZED, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.SHOW.MAXIMIZED")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
            {{{  SW.SHOW.NORMAL
            show.window (from.isv, to.isv, active.window.handle,
                         SW.SHOW.NORMAL, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.SHOW.NORMAL")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
            {{{  SW.SHOW
            show.window (from.isv, to.isv, active.window.handle,
                         SW.SHOW, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.SHOW")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
            {{{  SW.SHOW.MINIMIZED
            show.window (from.isv, to.isv, active.window.handle,
                         SW.SHOW.MINIMIZED, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.SHOW.MINIMIZED")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
            {{{  SW.SHOW.NA
            show.window (from.isv, to.isv, active.window.handle,
                         SW.SHOW.NA, isv.result)
            write.string.nl (from.isv, to.isv, stream.id, isv.result, "SW.SHOW.NA")
            write.nl        (from.isv, to.isv, stream.id, isv.result)
            {{{  Poll for a key
            BYTE  key.code:
            INT   items.left.in.buffer:
            TIMER clock:
            INT   start.time, current.time:
            SEQ
              clock ? start.time
              clock ? current.time
              clock ? AFTER (start.time PLUS 1000)
              WHILE running AND ((current.time MINUS start.time) < 45000)
                SEQ
                  get.key (from.isv, to.isv, stream.id, items.left.in.buffer, key.code, isv.result)
                  clock ? current.time
                  running := running AND (key.code <> ' ')
                  running := running AND (isv.result = SPR.OK)
             
             
       
      {{{  SW.SHOW.NORMAL
      show.window (from.isv, to.isv, active.window.handle,
                   SW.SHOW.NORMAL, isv.result)
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow06.dcd
...F descriptor
--:::F xhcsow06.dds
...F link
--:::F xhcsow06.dlk
...F debug
--:::F xhcsow06.ddb
...F CODE SC code
--:::F xhcsow06.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne06.dcd
...F descriptor
--:::F esonne06.dds
...F CODE PROGRAM Window show demo
--:::F esonne06.cpr
 
===============================================================================
{{{  PROGRAM Wait event demo
{{{F 
--:::F esonne07.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow07.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    #USE wiserver.hdr
    #USE wiserver
    
    VAL INT32 stream.id IS SPID.STDOUT:
    BYTE isv.result, result:
    [2]INT32 strm.id:
    [4]INT16 rect, rect2:
     
    SEQ
      result     := SPR.OK
      isv.result := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Get event demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "========================")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This demonstration will open two text windows and display every event")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "(such as key presses). Use the escape key to close the windows.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "It demonstrates the use of the procedure PROC wait.event.")
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Open window 1
      open.text.window (from.isv, to.isv, "Window 1",
                           100, 100, 40, 10, 10, 20,
                           NO.ACTIVATE.TEXT.WIN.STYLE,
                           10, 100,
                           strm.id[0], result, rect)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open text window one.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press any key to continue.")
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Open window 2
      open.text.window (from.isv, to.isv, "Window 2",
                           (INT rect[2]) + 0, 100, 40, 20, 7, 14,
                           NO.ACTIVATE.TEXT.WIN.STYLE,
                           10, 100,
                           strm.id[1], result, rect2)
       
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open text window two.")
      write.string    (from.isv, to.isv, stream.id, isv.result, "result = ")
      write.int       (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.nl        (from.isv, to.isv, stream.id, isv.result)
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press any key to continue.")
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
       
      {{{  Print the events as they happen in the two windows
      SEQ
        {{{  Print request to enter data
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Press keys in text windows.")
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Escape will close the window.")
         
        [SIZE strm.id]CHAN OF SP from.isv.chan, to.isv.chan:
        PAR
          {{{  Multiplexor
          INT no.of.open.windows:
          [MAX.PACKET.SIZE]BYTE buffer:
          INT16 buf.size:
          SEQ
            no.of.open.windows := SIZE from.isv.chan
            WHILE no.of.open.windows > 0
              ALT i = 0 FOR SIZE to.isv.chan
                to.isv.chan[i] ? buf.size::buffer
                  IF
                    buffer[0] = SP.EXIT
                      SEQ
                        no.of.open.windows := no.of.open.windows - 1
                        from.isv.chan[i] ! 6 (INT16)::[SPR.OK, SPR.OK, SPR.OK, SPR.OK, SPR.OK, SPR.OK]
                    TRUE
                      SEQ
                        to.isv ! buf.size::buffer
                        from.isv ? buf.size::buffer
                        from.isv.chan[i] ! buf.size::buffer
           
          {{{  Window process to print events
          PAR i = 0 FOR SIZE from.isv.chan
            {{{  Declarations
            INT16 virtual.key.code, system.key.flags:
            BYTE ascii.key.code:
            [2]INT pointer.pos:
            INT32 system.tick.value:
            BYTE result, wait.result:
            BOOL running:
             
            SEQ
              running := TRUE
              result := SPR.OK
              WHILE running
                SEQ
                  wait.result := SPR.OK
                  {{{  Wait for an event
                  wait.event (from.isv.chan[i], to.isv.chan[i],
                              strm.id[i],
                              virtual.key.code, system.key.flags,
                              ascii.key.code,
                              pointer.pos,
                              system.tick.value,
                              1500,
                              wait.result)
                   
                  {{{  Goto 0, 0
                  goto.xy (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, 0, 0)
                   
                  {{{  write virtual key code
                  write.string    (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "Virtual key code  = ")
                  write.int       (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, INT virtual.key.code, 4)
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "    ")
                   
                  {{{  write system key flags
                  write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "System key flags  = ")
                  SEQ j = 0 FOR 16
                    IF
                      (((INT system.key.flags) << j) /\ #8000) = 0
                        write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "0")
                      TRUE
                        write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "1")
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "    ")
                   
                  {{{  write ascii key code
                  write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "Ascii key code    = ")
                  write.int    (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, INT ascii.key.code, 4)
                  IF
                    ((INT ascii.key.code) >= 32) AND ((INT ascii.key.code) <= 126)
                      SEQ
                        write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "  *'")
                        write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, [ascii.key.code])
                        write.string (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "*'")
                    TRUE
                      SKIP
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "      ")
                   
                  {{{  write pointer pos
                  write.string    (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "X Pointer pos     = ")
                  write.int       (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, INT pointer.pos[0], 4)
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "    ")
                  write.string    (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "Y Pointer pos     = ")
                  write.int       (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, INT pointer.pos[1], 4)
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "    ")
                   
                  {{{  write system tick value
                  write.string    (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "System tick value = ")
                  write.int       (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, INT system.tick.value, 4)
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "    ")
                   
                  {{{  write result
                  write.string    (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "Result            = ")
                  write.int       (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, INT wait.result, 4)
                  write.string.nl (from.isv.chan[i], to.isv.chan[i], strm.id[i], result, "    ")
                   
                  running := ascii.key.code <> 27 (BYTE)
              {{{  Close window and send exit tag
              close.stream (from.isv.chan[i], to.isv.chan[i], strm.id[i], result)
              exit.server (from.isv.chan[i], to.isv.chan[i], SPS.SUCCESS)
               
           
       
      wait.any.event  (from.isv, to.isv, stream.id, isv.result)
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow07.dcd
...F descriptor
--:::F xhcsow07.dds
...F link
--:::F xhcsow07.dlk
...F debug
--:::F xhcsow07.ddb
...F CODE SC code
--:::F xhcsow07.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne07.dcd
...F descriptor
--:::F esonne07.dds
...F CODE PROGRAM Wait event demo
--:::F esonne07.cpr
 
===============================================================================
{{{  PROGRAM Graphic window demo
{{{F 
--:::F esonneso.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsowqo.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    {{{  #USE
    #USE wiserver.hdr
    #USE wiserver
    #USE graphics.window
     
    VAL INT16 dll.index IS 1 (INT16):
    VAL INT32 stream.id IS SPID.STDOUT:
    
    BYTE     isv.result:
    BYTE     result:
    INT16    dll.handle:
    INT      lines.free:
    [3]INT16 window.id:
     
    SEQ
      isv.result := SPR.OK
      {{{  Introduction
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Graphic DLL demonstration")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "=========================")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, " ")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "This program demonstates a simple DLL used to display line objects. The source")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "for the DLL is supplied and it is hoped that third parties will write some.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "The DLL used here stores the coordinates for an object and displays it")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "within a window. This program will create two windows and display a geometrical")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "shape. The shape is scaled according to the size of the window. The results of")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "every procedure call is displayed and the user is requested to press a key.")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, " ")
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "At start up.")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl  (from.isv, to.isv, stream.id, isv.result)
      write.nl  (from.isv, to.isv, stream.id, isv.result)
       
    
      load.dll (from.isv, to.isv, "C:\PROJECTS\WISERVER\GRAPHWIN.DLL",
                dll.index, dll.handle, isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Load DLL")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      write.string (from.isv, to.isv, stream.id, isv.result, "DLL handle = ")
      write.int (from.isv, to.isv, stream.id, isv.result, INT dll.handle, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      open.graphic.window (from.isv, to.isv, dll.index,
                           100, 100, 200, 200, "Ten points", window.id[0], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open graphic window one")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      graphic.lines.free (from.isv, to.isv, dll.index, window.id[0],
                          lines.free, isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Return lines free in window one")
      write.string (from.isv, to.isv, stream.id, isv.result, "lines free = ")
      write.int (from.isv, to.isv, stream.id, isv.result, lines.free, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      open.graphic.window (from.isv, to.isv, dll.index,
                           300, 100, 200, 200, "Twenty points", window.id[1], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open graphic window two")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      graphic.lines.free (from.isv, to.isv, dll.index, window.id[1],
                          lines.free, isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Return lines free in window two")
      write.string (from.isv, to.isv, stream.id, isv.result, "lines free = ")
      write.int (from.isv, to.isv, stream.id, isv.result, lines.free, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      open.graphic.window (from.isv, to.isv, dll.index,
                           500, 100, 200, 200, "Forty points", window.id[2], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Open graphic window three")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      graphic.lines.free (from.isv, to.isv, dll.index, window.id[2],
                          lines.free, isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Return lines free in window three")
      write.string (from.isv, to.isv, stream.id, isv.result, "lines free = ")
      write.int (from.isv, to.isv, stream.id, isv.result, lines.free, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      {{{  Add graphical lines to window 0
      #USE mathvals
      #USE snglmath
      VAL POINTS IS 10:
      VAL REAL32 RADIUS IS 0.45 (REAL32):
      [POINTS*POINTS][2]REAL32 points:
      [200][4]REAL32 lines:
      INT no.lines, lines.left:
      SEQ
        {{{  Calculate the points around the circle
        SEQ i = 0 FOR POINTS
          SEQ
            points[i][0] := 0.5 (REAL32) +
              (RADIUS * (SIN (((PI + PI)/(REAL32 ROUND POINTS)) * (REAL32 ROUND i))))
            points[i][1] := 0.5 (REAL32) +
              (RADIUS * (COS (((PI + PI)/(REAL32 ROUND POINTS)) * (REAL32 ROUND i))))
         
        {{{  Add the lines for the shape
        no.lines := 0
        SEQ i = 0 FOR POINTS - 1
          SEQ j = i FOR POINTS - i
            SEQ
              lines[no.lines][0] := points[i][0]
              lines[no.lines][1] := points[i][1]
              lines[no.lines][2] := points[j][0]
              lines[no.lines][3] := points[j][1]
              no.lines := no.lines + 1
         
        add.graphic.lines (from.isv, to.isv, dll.index, window.id[0],
                  [lines FROM 0 FOR no.lines], lines.left, isv.result)
        {{{  Write the result
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Lines added to window one")
        write.string (from.isv, to.isv, stream.id, isv.result, "lines left over = ")
        write.int (from.isv, to.isv, stream.id, isv.result, lines.left, 4)
        write.nl (from.isv, to.isv, stream.id, isv.result)
        write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
        result := isv.result
        write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
        write.nl (from.isv, to.isv, stream.id, isv.result)
        wait.any.event (from.isv, to.isv, stream.id, isv.result)
        write.nl (from.isv, to.isv, stream.id, isv.result)
         
       
      {{{  Add graphical lines to window 1
      #USE mathvals
      #USE snglmath
      VAL POINTS IS 20:
      VAL REAL32 RADIUS IS 0.45 (REAL32):
      [POINTS][2]REAL32 points:
      [POINTS*POINTS][4]REAL32 lines:
      INT no.lines, lines.left:
      SEQ
        {{{  Calculate the points around the circle
        SEQ i = 0 FOR POINTS
          SEQ
            points[i][0] := 0.5 (REAL32) +
              (RADIUS * (SIN (((PI + PI)/(REAL32 ROUND POINTS)) * (REAL32 ROUND i))))
            points[i][1] := 0.5 (REAL32) +
              (RADIUS * (COS (((PI + PI)/(REAL32 ROUND POINTS)) * (REAL32 ROUND i))))
         
        {{{  Add the lines for the shape
        no.lines := 0
        SEQ i = 0 FOR POINTS - 1
          SEQ j = i FOR POINTS - i
            SEQ
              lines[no.lines][0] := points[i][0]
              lines[no.lines][1] := points[i][1]
              lines[no.lines][2] := points[j][0]
              lines[no.lines][3] := points[j][1]
              no.lines := no.lines + 1
         
        add.graphic.lines (from.isv, to.isv, dll.index, window.id[1],
                  [lines FROM 0 FOR no.lines], lines.left, isv.result)
        {{{  Write the result
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Lines added to window two")
        write.string (from.isv, to.isv, stream.id, isv.result, "lines left over = ")
        write.int (from.isv, to.isv, stream.id, isv.result, lines.left, 4)
        write.nl (from.isv, to.isv, stream.id, isv.result)
        write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
        result := isv.result
        write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
        write.nl (from.isv, to.isv, stream.id, isv.result)
        wait.any.event (from.isv, to.isv, stream.id, isv.result)
        write.nl (from.isv, to.isv, stream.id, isv.result)
         
       
      {{{  Add graphical lines to window 2
      #USE mathvals
      #USE snglmath
      VAL POINTS IS 40:
      VAL REAL32 RADIUS IS 0.45 (REAL32):
      [POINTS][2]REAL32 points:
      [POINTS*POINTS][4]REAL32 lines:
      INT no.lines, lines.left:
      SEQ
        {{{  Calculate the points around the circle
        SEQ i = 0 FOR POINTS
          SEQ
            points[i][0] := 0.5 (REAL32) +
              (RADIUS * (SIN (((PI + PI)/(REAL32 ROUND POINTS)) * (REAL32 ROUND i))))
            points[i][1] := 0.5 (REAL32) +
              (RADIUS * (COS (((PI + PI)/(REAL32 ROUND POINTS)) * (REAL32 ROUND i))))
         
        {{{  Add the lines for the shape
        no.lines := 0
        SEQ i = 0 FOR POINTS - 1
          SEQ j = i FOR POINTS - i
            SEQ
              lines[no.lines][0] := points[i][0]
              lines[no.lines][1] := points[i][1]
              lines[no.lines][2] := points[j][0]
              lines[no.lines][3] := points[j][1]
              no.lines := no.lines + 1
         
        add.graphic.lines (from.isv, to.isv, dll.index, window.id[2],
                  [lines FROM 0 FOR no.lines], lines.left, isv.result)
        {{{  Write the result
        write.string.nl (from.isv, to.isv, stream.id, isv.result, "Lines added to window three")
        write.string (from.isv, to.isv, stream.id, isv.result, "lines left over = ")
        write.int (from.isv, to.isv, stream.id, isv.result, lines.left, 4)
        write.nl (from.isv, to.isv, stream.id, isv.result)
        write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
        result := isv.result
        write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
        write.nl (from.isv, to.isv, stream.id, isv.result)
        wait.any.event (from.isv, to.isv, stream.id, isv.result)
        write.nl (from.isv, to.isv, stream.id, isv.result)
         
       
    
      clear.all.graphic.lines (from.isv, to.isv,
                            dll.index, window.id[0], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Clear graphic window one")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      clear.all.graphic.lines (from.isv, to.isv,
                            dll.index, window.id[1], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Clear graphic window two")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      clear.all.graphic.lines (from.isv, to.isv,
                            dll.index, window.id[2], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Clear graphic window three")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      close.graphic.window (from.isv, to.isv, dll.index, window.id[0], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close graphic window one")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      close.graphic.window (from.isv, to.isv, dll.index, window.id[1], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close graphic window two")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      close.graphic.window (from.isv, to.isv, dll.index, window.id[2], isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Close graphic window three")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
      unload.dll (from.isv, to.isv, dll.index, isv.result)
      {{{  Write the result
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "Unload the DLL")
      write.string (from.isv, to.isv, stream.id, isv.result, "isv.result = ")
      result := isv.result
      write.int (from.isv, to.isv, stream.id, isv.result, INT result, 4)
      write.nl (from.isv, to.isv, stream.id, isv.result)
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      write.nl (from.isv, to.isv, stream.id, isv.result)
       
    
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsowqo.dcd
...F descriptor
--:::F xhcsowqo.dds
...F link
--:::F xhcsowqo.dlk
...F debug
--:::F xhcsowqo.ddb
...F CODE SC code
--:::F xhcsowqo.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonneso.dcd
...F descriptor
--:::F esonneso.dds
...F CODE PROGRAM Graphic window demo
--:::F esonneso.cpr
 
===============================================================================
{{{  PROGRAM Manipulator demo
{{{F 
--:::F esonne08.tsr
#USE wiserver.hdr
CHAN OF SP from.isv, to.isv:

{{{  SC code
{{{F 
--:::F xhcsow08.tsr
#USE wiserver.hdr
#USE wiserver
PROC code (CHAN OF SP from.isv, to.isv)
  SEQ
    {{{  EXE code
    {{{  Declarations
    {{{  #USE
    #USE wiserver.hdr
    #USE wiserver
    #USE graphics.window
    #USE mathvals
     
    VAL INT16  dll.index IS 1 (INT16):
    VAL INT32  stream.id IS SPID.STDOUT:
    VAL REAL32 ZOOM      IS 0.35 (REAL32):
    VAL REAL32 ANGLE     IS 0.5 (REAL32):
    VAL INT    MAX.LINKS IS 10:
    
    TIMER clock:
    INT option:
    INT time:
    BYTE  isv.result:
    INT16 dll.handle:
    INT16 window.id:
    [1000][6]REAL32 lines.3D:
    INT no.of.3D.lines:
    INT lines.left:
    [1000]REAL32 robot.def:
    [MAX.LINKS][3]REAL32 joint.values:
    {{{  Robot definition constants
    VAL REAL32 POINT.ID     IS 99.0 (REAL32):
    VAL REAL32 LINE.ID      IS 99.1 (REAL32):
    VAL REAL32 TRANSFORM.ID IS 99.2 (REAL32):
    VAL REAL32 TRANS.X.ID   IS 99.3 (REAL32):
    VAL REAL32 TRANS.Y.ID   IS 99.4 (REAL32):
    VAL REAL32 TRANS.Z.ID   IS 99.5 (REAL32):
    VAL REAL32 ROT.X.ID     IS 99.6 (REAL32):
    VAL REAL32 ROT.Y.ID     IS 99.7 (REAL32):
    VAL REAL32 ROT.Z.ID     IS 99.8 (REAL32):
    VAL REAL32 END.ID       IS 99.9 (REAL32):
    
    
    VAL INT ROBOT.DEF.HEADER.SIZE    IS  3:
    VAL INT ROBOT.DEF.POINT.SIZE     IS  4:
    VAL INT ROBOT.DEF.LINE.SIZE      IS  3:
    VAL INT ROBOT.DEF.TRANSFORM.SIZE IS 20:
     
    
    {{{  INT FUNCTION int (VAL REAL32 real)
    INT FUNCTION int (VAL REAL32 real)
      VAL INT n RETYPES real:
      VALOF
        SKIP
        RESULT n
    :
     
    {{{  REAL32 FUNCTION real (VAL INT int)
    REAL32 FUNCTION real (VAL INT int)
      VAL REAL32 n RETYPES int:
      VALOF
        SKIP
        RESULT n
    :
     
    {{{  PROC add.point ([]REAL32 robot.def, VAL REAL32 x, y, z)
    PROC add.point ([]REAL32   robot.def,
                    VAL REAL32 x, y, z)
      INT p:
      SEQ
        p := int (robot.def[1])
        robot.def[p+0] := POINT.ID
        robot.def[p+1] := x
        robot.def[p+2] := y
        robot.def[p+3] := z
        robot.def[1]   := real (p + ROBOT.DEF.POINT.SIZE)
    :
     
    {{{  PROC add.line ([]REAL32 robot.def, VAL INT id1, id2)
    PROC add.line ([]REAL32 robot.def,
                   VAL INT  id1, id2)
      INT p:
      SEQ
        p := int (robot.def[1])
        robot.def[p+0] := LINE.ID
        robot.def[p+1] := real (id1)
        robot.def[p+2] := real (id2)
        robot.def[1] := real (p + ROBOT.DEF.LINE.SIZE)
    :
     
    {{{  PROC add.axis ([]REAL32 robot.def, VAL REAL32 x, y, z, size)
    PROC add.axis ([]REAL32   robot.def,
                   VAL REAL32 x, y, z, size)
      INT point.id:
      SEQ
        point.id := (int (robot.def[1]) - int (robot.def[0])) / ROBOT.DEF.POINT.SIZE
    
        add.point (robot.def, x, y, z)
        add.point (robot.def, x + size, y, z)
        add.point (robot.def, x, y + size, z)
        add.point (robot.def, x, y, z + size)
    
        add.line (robot.def, point.id, point.id + 1)
        add.line (robot.def, point.id, point.id + 2)
        add.line (robot.def, point.id, point.id + 3)
    :
     
    {{{  PROC add.transform ([]REAL32 robot.def, joint.values, VAL [16]REAL32 m, VAL REAL32 transform.type.id, min, max)
    PROC add.transform ([]REAL32       robot.def,
                        [][3]REAL32    joint.values,
                        VAL [16]REAL32 m,
                        VAL REAL32     transform.type.id, min, max)
      INT p:
      SEQ
        p := int (robot.def[1])
        robot.def[p+0] := TRANSFORM.ID
        SEQ i = 0 FOR 16
          robot.def[(p + 1) + i] := m[i]
        robot.def[p+17] := transform.type.id
        robot.def[p+18] := min
        robot.def[p+19] := max
    
        p := p + ROBOT.DEF.TRANSFORM.SIZE
        robot.def[1] := real (p)
        robot.def[0] := robot.def[1]
    
        joint.values[int (robot.def[2])][0] := (min + max) / 2.0 (REAL32)
        joint.values[int (robot.def[2])][1] := min
        joint.values[int (robot.def[2])][2] := max
    
        robot.def[2] := real (int (robot.def[2]) + 1)
    :
     
    {{{  PROC end.robot.def ([]REAL32 robot.def)
    PROC end.robot.def ([]REAL32 robot.def)
      INT p:
      SEQ
        p := int (robot.def[1])
        robot.def[p] := END.ID
    :
     
    
    {{{  General matrix procs
    {{{  PROC unity.4x4 ([16]REAL32 r)
    PROC unity.4x4 ([16]REAL32 r)
      [4][4]REAL32 m RETYPES r:
      SEQ i = 0 FOR 4
        SEQ j = 0 FOR 4
          IF
            i = j
              m[i][j] := 1.0 (REAL32)
            TRUE
              m[i][j] := 0.0 (REAL32)
    :
     
    {{{  PROC mult.4x4 (VAL [16]REAL32 m1, m2, [16]REAL32 r)
    PROC mult.4x4 (VAL [16]REAL32 m1, m2, [16]REAL32 r)
      SEQ
        SEQ i = 0 FOR 16
          r[i] := 0.0 (REAL32)
        SEQ i = 0 FOR 4
          SEQ j = 0 FOR 4
            SEQ k = 0 FOR 4
              r[i+(4*j)] := r[i+(4*j)] + (m1[k+(4*j)] * m2[i+(4*k)])
    :
     
    {{{  PROC mult2.4x4 (VAL [16]REAL32 m1, [16]REAL32 m2)
    PROC mult2.4x4 (VAL [16]REAL32 m1, [16]REAL32 m2)
      [16]REAL32 r:
      SEQ
        mult.4x4 (m1, m2, r)
        SEQ i = 0 FOR 16
          m2[i] := r[i]
    :
     
    {{{  PROC mult2.4x4.4x1 (VAL [16]REAL32 m1, [4]REAL32 m2)
    PROC mult2.4x4.4x1 (VAL [16]REAL32 m1, [4]REAL32 m2)
      [4]REAL32 r:
      VAL [4][4]REAL32 m RETYPES m1:
      SEQ
        r[0] := ((m[0][0] * m2[0]) + (m[0][1] * m2[1])) +
                ((m[0][2] * m2[2]) + (m[0][3] * m2[3]))
        r[1] := ((m[1][0] * m2[0]) + (m[1][1] * m2[1])) +
                ((m[1][2] * m2[2]) + (m[1][3] * m2[3]))
        r[2] := ((m[2][0] * m2[0]) + (m[2][1] * m2[1])) +
                ((m[2][2] * m2[2]) + (m[2][3] * m2[3]))
        r[3] := ((m[3][0] * m2[0]) + (m[3][1] * m2[1])) +
                ((m[3][2] * m2[2]) + (m[3][3] * m2[3]))
        SEQ i = 0 FOR 4
          m2[i] := r[i]
    :
     
    {{{  PROC joint.transform (VAL REAL32 transform.type.id, value, [16]REAL32 m)
    PROC joint.transform (VAL REAL32 transform.type.id, value,
                          [16]REAL32 m)
      #USE snglmath
      SEQ
        unity.4x4 (m)
        IF
          transform.type.id = TRANS.X.ID
            m[3 + (0 * 4)] := value
          transform.type.id = TRANS.Y.ID
            m[3 + (1 * 4)] := value
          transform.type.id = TRANS.Z.ID
            m[3 + (2 * 4)] := value
          transform.type.id = ROT.X.ID
            REAL32 v:
            SEQ
              v := (value / 180.0 (REAL32)) * 3.14159274 (REAL32)
              m[1 + (1 * 4)] :=  COS(v)
              m[2 + (1 * 4)] := -SIN(v)
              m[1 + (2 * 4)] :=  SIN(v)
              m[2 + (2 * 4)] :=  COS(v)
          transform.type.id = ROT.Y.ID
            REAL32 v:
            SEQ
              v := (value / 180.0 (REAL32)) * 3.14159274 (REAL32)
              m[0 + (0 * 4)] :=  COS(v)
              m[0 + (2 * 4)] := -SIN(v)
              m[2 + (0 * 4)] :=  SIN(v)
              m[2 + (2 * 4)] :=  COS(v)
          transform.type.id = ROT.Z.ID
            REAL32 v:
            SEQ
              v := (value / 180.0 (REAL32)) * 3.14159274 (REAL32)
              m[0 + (0 * 4)] :=  COS(v)
              m[1 + (0 * 4)] := -SIN(v)
              m[0 + (1 * 4)] :=  SIN(v)
              m[1 + (1 * 4)] :=  COS(v)
          TRUE
            CAUSEERROR ()
    :
     
    {{{  PROC transform (VAL REAL32 transform.type.id, value, [16]REAL32 m)
    PROC transform (VAL REAL32 transform.type.id, value,
                    [16]REAL32 m)
      [16]REAL32 r:
      SEQ
        joint.transform (transform.type.id, value, r)
        mult2.4x4 (r, m)
    :
     
     
    
    {{{  PROC add.3D.lines
    PROC add.3D.lines (CHAN OF SP      from.isv, to.isv,
                       VAL INT16       dll.index, window.id,
                       VAL [][6]REAL32 lines.3D,
                       VAL REAL32      ZOOM, ANGLE,
                       INT             lines.left,
                       BYTE            isv.result)
      [1000][4]REAL32 lines.2D:
      REAL32 offset, angle2:
      SEQ
        offset := (1.0 (REAL32) - ZOOM) * 0.5 (REAL32)
        angle2 := 1.0 (REAL32) - ANGLE
        SEQ i = 0 FOR SIZE lines.3D
          SEQ
            {{{  First point
            lines.2D[i][0] := lines.3D[i][0] - (ANGLE * lines.3D[i][1])
            lines.2D[i][1] := 1.0 (REAL32) -
                              (lines.3D[i][2] - (angle2 * lines.3D[i][1]))
             
            {{{  Second point
            lines.2D[i][2] := lines.3D[i][3] - (ANGLE * lines.3D[i][4])
            lines.2D[i][3] := 1.0 (REAL32) -
                              (lines.3D[i][5] - (angle2 * lines.3D[i][4]))
             
            {{{  Adjust for ZOOM
            lines.2D[i][0] := (lines.2D[i][0] * ZOOM) + offset
            lines.2D[i][1] := (lines.2D[i][1] * ZOOM) + offset
            lines.2D[i][2] := (lines.2D[i][2] * ZOOM) + offset
            lines.2D[i][3] := (lines.2D[i][3] * ZOOM) + offset
             
        add.graphic.lines (from.isv, to.isv, dll.index, window.id,
                           [lines.2D FROM 0 FOR SIZE lines.3D],
                           lines.left, isv.result)
    :
     
    {{{  PROC generate.robot.image
    PROC generate.robot.image ([][6]REAL32     lines.3D,
                               INT             no.of.3D.lines,
                               VAL []REAL32    robot.def,
                               VAL [][3]REAL32 joint.values)
      {{{  PROC add.3d.line
      PROC add.3d.line ([][6]REAL32 lines.3d, INT no.of.lines,
                        VAL REAL32 x0, y0, z0, x1, y1, z1)
        SEQ
          lines.3d[no.of.lines][0] := x0
          lines.3d[no.of.lines][1] := y0
          lines.3d[no.of.lines][2] := z0
          lines.3d[no.of.lines][3] := x1
          lines.3d[no.of.lines][4] := y1
          lines.3d[no.of.lines][5] := z1
          no.of.lines := no.of.lines + 1
      :
       
      INT joint.no, robot.pointer:
      [100][4]REAL32 points:
      [16]REAL32 i, t:
      SEQ
        joint.no := 0
        robot.pointer := ROBOT.DEF.HEADER.SIZE
        unity.4x4 (i)
    
        WHILE robot.def[robot.pointer] <> END.ID
          SEQ
            {{{  Read in all the points
            INT no.of.points:
            SEQ
              no.of.points := 0
              {{{  Initialise point values to infinity
              SEQ i = 0 FOR SIZE points[0]
                SEQ
                  points[i][0] := INFINITY
                  points[i][1] := INFINITY
                  points[i][2] := INFINITY
               
            
              WHILE robot.def[robot.pointer] = POINT.ID
                SEQ
                  points[no.of.points][0] := robot.def[robot.pointer + 1]
                  points[no.of.points][1] := robot.def[robot.pointer + 2]
                  points[no.of.points][2] := robot.def[robot.pointer + 3]
                  points[no.of.points][3] := 1.0 (REAL32)
                  mult2.4x4.4x1 (i, points[no.of.points]) -- Rotate the point. --
            
                  no.of.points := no.of.points + 1
                  robot.pointer := robot.pointer + ROBOT.DEF.POINT.SIZE
             
            {{{  Read in all the lines
            
            WHILE robot.def[robot.pointer] = LINE.ID
              INT p1, p2:
              SEQ
                p1 := int (robot.def[robot.pointer + 1])
                p2 := int (robot.def[robot.pointer + 2])
                add.3d.line (lines.3D, no.of.3D.lines,
                             points[p1][0], points[p1][1], points[p1][2],
                             points[p2][0], points[p2][1], points[p2][2])
            
                robot.pointer := robot.pointer + ROBOT.DEF.LINE.SIZE
            
            
             
            {{{  Now transform the frame matrix
            WHILE robot.def[robot.pointer] = TRANSFORM.ID
              SEQ
                t := [robot.def FROM robot.pointer + 1 FOR 16]
                mult2.4x4 (i, t)
                i := t
            
                joint.transform (robot.def[robot.pointer + 17],
                                 joint.values[joint.no][0], t)
                mult2.4x4 (i, t)
                i := t
            
                robot.pointer := robot.pointer + ROBOT.DEF.TRANSFORM.SIZE
                joint.no := joint.no + 1
             
    :
     
     
    SEQ
      isv.result := SPR.OK
      {{{  Initialise 3D.lines
      SEQ i = 0 FOR SIZE lines.3D[0]
        SEQ j = 0 FOR SIZE lines.3D
          lines.3D[j][i] := INFINITY
       
      {{{  Define the robot
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "1 - Carteasian")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "2 - Revolute")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "3 - Spherical")
      write.string.nl (from.isv, to.isv, stream.id, isv.result, "4 - ALASCA")
      get.option (from.isv, to.isv, stream.id, "1234", option, POLL.PERIOD, FALSE, FALSE, isv.result)
      IF
        option = 0
          {{{  Define the robot (Carteasian)
          [16]REAL32 m:
          SEQ
            {{{  Set up robot.def as an empty definition
            robot.def[0] := real (ROBOT.DEF.HEADER.SIZE) -- Start of current link def. --
            robot.def[1] := real (ROBOT.DEF.HEADER.SIZE) -- Rolling pointer during def. --
            robot.def[2] := real (0)                     -- Number of joints defined so far. --
             
          
            {{{  Joint 1
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.1 (REAL32),  0.0 (REAL32)) -- point 2
            add.point (robot.def,  0.1 (REAL32), -0.1 (REAL32),  0.0 (REAL32)) -- point 3
            add.point (robot.def, -0.1 (REAL32), -0.1 (REAL32),  0.0 (REAL32)) -- point 4
            add.point (robot.def, -0.1 (REAL32),  0.1 (REAL32),  0.0 (REAL32)) -- point 5
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 6
            add.point (robot.def,  0.0 (REAL32),  1.0 (REAL32),  0.5 (REAL32)) -- point 7
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 3)
            add.line (robot.def, 3, 4)
            add.line (robot.def, 4, 5)
            add.line (robot.def, 5, 2)
            add.line (robot.def, 6, 7)
            
            unity.4x4 (m)
            transform (TRANS.Z.ID, 0.5 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, TRANS.Y.ID,
                           0.0 (REAL32), 1.0 (REAL32))
             
            {{{  Joint 2
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  1.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 1
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            
            add.transform (robot.def, joint.values, m, TRANS.X.ID,
                           0.0 (REAL32), 1.0 (REAL32))
             
            {{{  Joint 3
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  1.0 (REAL32)) -- point 1
            
            add.axis (robot.def, 0.1 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            
            add.transform (robot.def, joint.values, m, TRANS.Z.ID,
                           0.0 (REAL32), -0.5 (REAL32))
             
            {{{  End bit
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.1 (REAL32),  0.5 (REAL32)) -- point 2
            add.point (robot.def,  0.1 (REAL32), -0.1 (REAL32),  0.5 (REAL32)) -- point 3
            add.point (robot.def, -0.1 (REAL32), -0.1 (REAL32),  0.5 (REAL32)) -- point 4
            add.point (robot.def, -0.1 (REAL32),  0.1 (REAL32),  0.5 (REAL32)) -- point 5
            
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 4)
            add.line (robot.def, 3, 5)
            
             
          
            end.robot.def (robot.def)
          
           
        option = 1
          {{{  Define the robot (Revolute)
          [16]REAL32 m:
          SEQ
            {{{  Set up robot.def as an empty definition
            robot.def[0] := real (ROBOT.DEF.HEADER.SIZE) -- Start of current link def. --
            robot.def[1] := real (ROBOT.DEF.HEADER.SIZE) -- Rolling pointer during def. --
            robot.def[2] := real (0)                     -- Number of joints defined so far. --
             
          
            {{{  Joint 1
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            
            unity.4x4 (m)
            
            add.transform (robot.def, joint.values, m, ROT.Z.ID,
                           0.0 (REAL32), 90.0 (REAL32))
             
            {{{  Joint 2
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.1 (REAL32),  0.0 (REAL32)) -- point 2
            add.point (robot.def,  0.1 (REAL32), -0.1 (REAL32),  0.0 (REAL32)) -- point 3
            add.point (robot.def, -0.1 (REAL32), -0.1 (REAL32),  0.0 (REAL32)) -- point 4
            add.point (robot.def, -0.1 (REAL32),  0.1 (REAL32),  0.0 (REAL32)) -- point 5
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 3)
            add.line (robot.def, 3, 4)
            add.line (robot.def, 4, 5)
            add.line (robot.def, 5, 2)
            
            unity.4x4 (m)
            transform (TRANS.Z.ID, 0.5 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, ROT.Y.ID,
                           0.0 (REAL32), 90.0 (REAL32))
             
            {{{  Joint 3
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.3 (REAL32)) -- point 1
            
            add.axis (robot.def, 0.1 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            transform (TRANS.Z.ID, 0.3 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, ROT.Y.ID,
                           0.0 (REAL32), 90.0 (REAL32))
             
            {{{  End bit
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.1 (REAL32),  0.5 (REAL32)) -- point 2
            add.point (robot.def,  0.1 (REAL32), -0.1 (REAL32),  0.5 (REAL32)) -- point 3
            add.point (robot.def, -0.1 (REAL32), -0.1 (REAL32),  0.5 (REAL32)) -- point 4
            add.point (robot.def, -0.1 (REAL32),  0.1 (REAL32),  0.5 (REAL32)) -- point 5
            
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 4)
            add.line (robot.def, 3, 5)
            
             
          
            end.robot.def (robot.def)
          
           
        option = 2
          {{{  Define the robot (Spherical)
          [16]REAL32 m:
          SEQ
            {{{  Set up robot.def as an empty definition
            robot.def[0] := real (ROBOT.DEF.HEADER.SIZE) -- Start of current link def. --
            robot.def[1] := real (ROBOT.DEF.HEADER.SIZE) -- Rolling pointer during def. --
            robot.def[2] := real (0)                     -- Number of joints defined so far. --
             
          
            {{{  Joint 1
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            
            unity.4x4 (m)
            
            add.transform (robot.def, joint.values, m, ROT.Z.ID,
                           0.0 (REAL32), 90.0 (REAL32))
             
            {{{  Joint 2
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.1 (REAL32),  0.0 (REAL32)) -- point 2
            add.point (robot.def,  0.1 (REAL32), -0.1 (REAL32),  0.0 (REAL32)) -- point 3
            add.point (robot.def, -0.1 (REAL32), -0.1 (REAL32),  0.0 (REAL32)) -- point 4
            add.point (robot.def, -0.1 (REAL32),  0.1 (REAL32),  0.0 (REAL32)) -- point 5
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 3)
            add.line (robot.def, 3, 4)
            add.line (robot.def, 4, 5)
            add.line (robot.def, 5, 2)
            
            unity.4x4 (m)
            transform (TRANS.Z.ID, 0.5 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, ROT.Y.ID,
                           90.0 (REAL32), 135.0 (REAL32))
             
            {{{  Joint 3
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.3 (REAL32)) -- point 1
            
            add.axis (robot.def, 0.1 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            
            add.transform (robot.def, joint.values, m, TRANS.Z.ID,
                           0.0 (REAL32), 0.25 (REAL32))
             
            {{{  End bit
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.1 (REAL32),  0.5 (REAL32)) -- point 2
            add.point (robot.def,  0.1 (REAL32), -0.1 (REAL32),  0.5 (REAL32)) -- point 3
            add.point (robot.def, -0.1 (REAL32), -0.1 (REAL32),  0.5 (REAL32)) -- point 4
            add.point (robot.def, -0.1 (REAL32),  0.1 (REAL32),  0.5 (REAL32)) -- point 5
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 4)
            add.line (robot.def, 3, 5)
            
             
          
            end.robot.def (robot.def)
          
           
        option = 3
          {{{  Define the robot (ALASCA)
          [16]REAL32 m:
          SEQ
            {{{  Set up robot.def as an empty definition
            robot.def[0] := real (ROBOT.DEF.HEADER.SIZE) -- Start of current link def. --
            robot.def[1] := real (ROBOT.DEF.HEADER.SIZE) -- Rolling pointer during def. --
            robot.def[2] := real (0)                     -- Number of joints defined so far. --
             
          
            {{{  Joint 1
            
            add.point (robot.def,  0.0 (REAL32), -1.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32), -1.0 (REAL32),  1.0 (REAL32)) -- point 1
            add.point (robot.def,  0.0 (REAL32),  1.0 (REAL32),  1.0 (REAL32)) -- point 2
            add.point (robot.def,  0.0 (REAL32),  1.0 (REAL32),  0.0 (REAL32)) -- point 3
            
            add.axis (robot.def, 0.2 (REAL32), 0.0 (REAL32), 0.0 (REAL32), 0.1 (REAL32))
            
            add.line (robot.def, 0, 1)
            add.line (robot.def, 1, 2)
            add.line (robot.def, 2, 3)
            add.line (robot.def, 3, 0)
            
            unity.4x4 (m)
            transform (TRANS.Z.ID, 0.9 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, TRANS.Y.ID,
                           -1.0 (REAL32), 1.0 (REAL32))
             
            {{{  Joint 2
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.1 (REAL32)) -- point 1
            
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            
            add.transform (robot.def, joint.values, m, ROT.Z.ID,
                           -45.0 (REAL32), 45.0 (REAL32))
             
            {{{  Joint 3
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.5 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 1
            
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            transform (TRANS.X.ID, 0.5 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, ROT.Z.ID,
                           -45.0 (REAL32), 45.0 (REAL32))
             
            {{{  Joint 4
            
            unity.4x4 (m)
            add.transform (robot.def, joint.values, m, TRANS.Z.ID,
                           0.0 (REAL32), 0.5 (REAL32))
             
            {{{  Joint 5
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0 (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32), -0.5 (REAL32)) -- point 1
            add.point (robot.def,  0.1 (REAL32),  0.0 (REAL32), -0.5 (REAL32)) -- point 2
            add.point (robot.def, -0.1 (REAL32),  0.0 (REAL32), -0.5 (REAL32)) -- point 3
            
            
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 3)
            
            unity.4x4 (m)
            transform (TRANS.Z.ID, -0.75 (REAL32), m)
            
            add.transform (robot.def, joint.values, m, ROT.Y.ID,
                           90.0 (REAL32), 180.0 (REAL32))
             
            {{{  Joint 6
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32),  0.0  (REAL32)) -- point 0
            add.point (robot.def,  0.0 (REAL32),  0.0 (REAL32), -0.25 (REAL32)) -- point 1
            
            
            add.line (robot.def, 0, 1)
            
            unity.4x4 (m)
            add.transform (robot.def, joint.values, m, ROT.Z.ID,
                           -45.0 (REAL32), 45.0 (REAL32))
             
            {{{  Joint 7
            
            unity.4x4 (m)
            add.transform (robot.def, joint.values, m, TRANS.Z.ID,
                           0.0 (REAL32), 0.25 (REAL32))
             
            {{{  Gripper
            add.point (robot.def,  0.0  (REAL32),  0.0 (REAL32),  0.0  (REAL32)) -- point 0
            add.point (robot.def,  0.0  (REAL32),  0.0 (REAL32), -0.25 (REAL32)) -- point 1
            add.point (robot.def,  0.05 (REAL32),  0.0 (REAL32),  0.0  (REAL32)) -- point 2
            add.point (robot.def, -0.05 (REAL32),  0.0 (REAL32),  0.0  (REAL32)) -- point 3
            add.point (robot.def,  0.05 (REAL32),  0.0 (REAL32),  0.03 (REAL32)) -- point 4
            add.point (robot.def, -0.05 (REAL32),  0.0 (REAL32),  0.03 (REAL32)) -- point 5
            
            
            add.line (robot.def, 0, 1)
            add.line (robot.def, 2, 3)
            add.line (robot.def, 2, 4)
            add.line (robot.def, 3, 5)
            
             
          
            end.robot.def (robot.def)
          
           
      
      {{{  COMMENT Attempt at file input
      --:::A COMMENT FOLD
      {{{  
      {{{  PROC strip.spaces ([]BYTE line, INT line.length)
      PROC strip.spaces ([]BYTE line, INT line.length)
        VAL BYTE SPACE IS ' ' (BYTE):
        INT i:
        SEQ
          i := 0
          WHILE (line[i] = SPACE) AND (i < line.length)
            i := i + 1
          SEQ j = 0 FOR i
            line[j] := line[j + i]
          line.length := line.length - i
      :
       
      {{{  PROC strip.end.spaces ([]BYTE line, INT line.length)
      PROC strip.end.spaces ([]BYTE line, INT line.length)
        VAL BYTE SPACE IS ' ' (BYTE):
        WHILE (line[line.length] = SPACE) AND (line.length > 0)
          line.length := line.length - 1
      :
       
      {{{  PROC get.next.word ([]BYTE line, INT line.length, []BYTE word, INT word.length)
      PROC get.next.word ([]BYTE line, INT line.length,
                          []BYTE word, INT word.length)
        VAL BYTE SPACE IS ' ' (BYTE):
        INT i:
        SEQ
          strip.spaces (line, line.length)
          i := 0
          WHILE (line[i] <> SPACE) AND ((i < line.length) AND (i < (SIZE word)))
            i := i + 1
          SEQ j = 0 FOR i
            SEQ
              word[j] := line[j]
              line[j] := line[j + i]
          line.length := line.length - i
          word.length := i
      :
       
      {{{  PROC get.next.int.number (line, line.length, value, ok)
      PROC get.next.int.number ([]BYTE line,
                                INT    line.length,
                                INT    value,
                                BOOL   ok)
        IF
          ok
            [16]BYTE word:
            INT word.length:
            SEQ
              get.next.word (line, line.length, word, word.length)
              #USE ioconv
              STRINGTOINT (ok, value, [word FROM 0 FOR word.length])
              ok := NOT ok
          TRUE
            SKIP
      :
       
      {{{  PROC get.next.real32.number (line, line.length, value, ok)
      PROC get.next.real32.number ([]BYTE line,
                                   INT    line.length,
                                   REAL32 value,
                                   BOOL   ok)
        IF
          ok
            [16]BYTE word:
            INT word.length:
            SEQ
              get.next.word (line, line.length, word, word.length)
              #USE extrio
              STRINGTOREAL32 (ok, value, [word FROM 0 FOR word.length])
              ok := NOT ok
          TRUE
            SKIP
      :
       
      {{{  PROC syntax.error ([]BYTE syntax.error.msg, INT syntax.error.len, VAL []BYTE error.msg)
      PROC syntax.error ([]BYTE     syntax.error.msg,
                         INT        syntax.error.len,
                         VAL []BYTE error.msg)
        SEQ
          [syntax.error.msg FROM 0 FOR SIZE error.msg] := error.msg
          syntax.error.len := SIZE error.msg
      :
       
      IF
        isv.result = SPR.OK
          VAL []BYTE filename IS "TEST.ROB":
          BYTE file.result:
          BYTE eof.result:
          INT last.command:
          INT32 file.id:
          INT line.number:
          [160]BYTE line, word:
          INT line.length, word.length:
          [80]BYTE syntax.error.msg:
          INT syntax.error.len:
          [16]REAL32 m:
          SEQ
            {{{  Set up robot.def as an empty definition
            robot.def[0] := real (ROBOT.DEF.HEADER.SIZE) -- Start of current link def. --
            robot.def[1] := real (ROBOT.DEF.HEADER.SIZE) -- Rolling pointer during def. --
            robot.def[2] := real (0)                     -- Number of joints defined so far. --
             
            file.result := SPR.OK
            syntax.error.len := 0
            last.command := 1
            open.file (from.isv, to.isv, file.id, filename, SPM.INPUT, SPT.TEXT, file.result)
            line.number := 0
            end.of.file (from.isv, to.isv, file.id, eof.result, file.result)
            WHILE ((eof.result = SPR.NOTOK) AND (file.result = SPR.OK)) AND (syntax.error.len = 0)
              SEQ
                read.text.line (from.isv, to.isv, file.id, line, line.length, file.result)
                line.number := line.number + 1
                {{{  Print the line
                write.int       (from.isv, to.isv, stream.id, isv.result, line.number, 3)
                write.string    (from.isv, to.isv, stream.id, isv.result, ": ")
                write.string.nl (from.isv, to.isv, stream.id, isv.result, [line FROM 0 FOR line.length])
                 
                strip.spaces (line, line.length)
                strip.end.spaces (line, line.length)
                get.next.word (line, line.length, word, word.length)
                #USE strings
                IF
                  {{{  Check for file error
                  file.result <> SPR.OK
                    SKIP
                   
                  {{{  Check for blank line
                  word.length = 0
                    SKIP
                   
                  {{{  Check for comment
                  word[0] = '#' (BYTE)
                    SKIP
                   
                  {{{  Check for DEF_POINT
                  eqstr ([word FROM 0 FOR word.length], "DEF_POINT")
                    IF
                      (last.command = 2) OR (last.command = 3)
                        syntax.error (syntax.error.msg, syntax.error.len, "DEF_POINT used just after DEF_AXIS or DEF_LINE")
                      TRUE
                        BOOL ok:
                        REAL32 x0, y0, z0:
                        SEQ
                          ok := TRUE
                          get.next.real32.number (line, line.length, x0, ok)
                          get.next.real32.number (line, line.length, y0, ok)
                          get.next.real32.number (line, line.length, z0, ok)
                          get.next.word (line, line.length, word, word.length)
                          {{{  Add the point if OK
                          IF
                            NOT ok
                              syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                            (word[0] <> '#' (BYTE)) OR (word.length <> 0)
                              syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                            TRUE
                              add.point (robot.def, x0, y0, z0)
                           
                          last.command := 1
                   
                  {{{  Check for DEF_AXIS
                  eqstr ([word FROM 0 FOR word.length], "DEF_AXIS")
                    IF
                      (last.command = 2) OR (last.command = 3)
                        syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                      BOOL ok:
                      REAL32 x0, y0, z0, axis.size:
                      TRUE
                        SEQ
                          ok := TRUE
                          get.next.real32.number (line, line.length, x0, ok)
                          get.next.real32.number (line, line.length, y0, ok)
                          get.next.real32.number (line, line.length, z0, ok)
                          get.next.real32.number (line, line.length, axis.size, ok)
                          get.next.word (line, line.length, word, word.length)
                          {{{  Add the axis if OK
                          IF
                            NOT ok
                              syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                            (word[0] <> '#' (BYTE)) OR (word.length <> 0)
                              syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                            TRUE
                              add.axis (robot.def, x0, y0, z0, axis.size)
                           
                          last.command := 2
                   
                  {{{  Check for DEF_LINE
                  eqstr ([word FROM 0 FOR word.length], "DEF_LINE")
                    IF
                      (last.command <> 1) AND (last.command <> 2)
                        syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                      TRUE
                        BOOL ok:
                        INT p0, p1:
                        SEQ
                          ok := TRUE
                          get.next.int.number (line, line.length, p0, ok)
                          get.next.int.number (line, line.length, p1, ok)
                          get.next.word (line, line.length, word, word.length)
                          {{{  Add the line if OK
                          IF
                            NOT ok
                              syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                            (word[0] <> '#' (BYTE)) OR (word.length <> 0)
                              syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                            TRUE
                              add.line (robot.def, p0, p1)
                           
                          last.command := 3
                   
                  {{{  Check for DEF_TRANSFORM
                  eqstr ([word FROM 0 FOR word.length], "DEF_TRANSFORM")
                    BOOL ok:
                    REAL32 transform.id:
                    REAL32 size:
                    SEQ
                      {{{  Check if this is the start of transforms
                      IF
                        last.command <> 4
                          unity.4x4 (m)
                        TRUE
                          SKIP
                       
                      ok := TRUE
                      get.next.word (line, line.length, word, word.length)
                      {{{  Get the transform id
                      IF
                        eqstr ([word FROM 0 FOR word.length], "TRANS.X")
                          transform.id := TRANS.X.ID
                        eqstr ([word FROM 0 FOR word.length], "TRANS.Y")
                          transform.id := TRANS.Y.ID
                        eqstr ([word FROM 0 FOR word.length], "TRANS.Z")
                          transform.id := TRANS.Z.ID
                        eqstr ([word FROM 0 FOR word.length], "ROT.X")
                          transform.id := ROT.X.ID
                        eqstr ([word FROM 0 FOR word.length], "ROT.Y")
                          transform.id := ROT.Y.ID
                        eqstr ([word FROM 0 FOR word.length], "ROT.Z")
                          transform.id := ROT.Z.ID
                        TRUE
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                       
                      get.next.real32.number (line, line.length, size, ok)
                      get.next.word (line, line.length, word, word.length)
                      IF
                        syntax.error.len <> 0
                          SKIP
                        NOT ok
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                        (word[0] <> '#' (BYTE)) AND (word.length <> 0)
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                        TRUE
                          transform (transform.id, size, m)
                  
                      last.command := 4
                   
                  {{{  Check for DEF_JOINT
                  eqstr ([word FROM 0 FOR word.length], "DEF_JOINT")
                    BOOL ok:
                    REAL32 transform.id:
                    REAL32 min, max:
                    SEQ
                      {{{  Check if transforms were defined in the last line
                      IF
                        last.command <> 4
                          unity.4x4 (m)
                        TRUE
                          SKIP
                       
                      ok := TRUE
                      get.next.word (line, line.length, word, word.length)
                      {{{  Get the transform id
                      IF
                        eqstr ([word FROM 0 FOR word.length], "TRANS.X")
                          transform.id := TRANS.X.ID
                        eqstr ([word FROM 0 FOR word.length], "TRANS.Y")
                          transform.id := TRANS.Y.ID
                        eqstr ([word FROM 0 FOR word.length], "TRANS.Z")
                          transform.id := TRANS.Z.ID
                        eqstr ([word FROM 0 FOR word.length], "ROT.X")
                          transform.id := ROT.X.ID
                        eqstr ([word FROM 0 FOR word.length], "ROT.Y")
                          transform.id := ROT.Y.ID
                        eqstr ([word FROM 0 FOR word.length], "ROT.Z")
                          transform.id := ROT.Z.ID
                        TRUE
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                       
                      get.next.real32.number (line, line.length, min, ok)
                      get.next.real32.number (line, line.length, max, ok)
                      get.next.word (line, line.length, word, word.length)
                      IF
                        syntax.error.len <> 0
                          SKIP
                        NOT ok
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                        (word[0] <> '#' (BYTE)) AND (word.length <> 0)
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                        TRUE
                          add.transform (robot.def, joint.values, m, transform.id, min, max)
                  
                      last.command := 5
                  
                   
                  {{{  Check for END_DEF
                  eqstr ([word FROM 0 FOR word.length], "END_DEF")
                    SEQ
                      get.next.word (line, line.length, word, word.length)
                      IF
                        (word[0] <> '#' (BYTE)) AND (word.length <> 0)
                          syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                        TRUE
                          end.robot.def (robot.def)
                  
                  
                      last.command := 99
                  
                   
                  TRUE
                    syntax.error (syntax.error.msg, syntax.error.len, "UNDEFINED_ERROR")
                end.of.file (from.isv, to.isv, file.id, eof.result, file.result)
      
      
            {{{  Check file reading
            IF
              (file.result <> SPR.OK) AND (line.number = 0)
                SEQ
                  write.string.nl (from.isv, to.isv, stream.id, isv.result, "CANNOT OPEN THE FILE")
                  wait.any.event  (from.isv, to.isv, stream.id, isv.result)
              file.result <> SPR.OK
                SEQ
                  write.string   (from.isv, to.isv, stream.id, isv.result, "ERROR READING FILE AT LINE")
                  write.int      (from.isv, to.isv, stream.id, isv.result, line.number, 0)
                  write.nl       (from.isv, to.isv, stream.id, isv.result)
                  wait.any.event (from.isv, to.isv, stream.id, isv.result)
            
              syntax.error.len <> 0
                SEQ
                  write.string (from.isv, to.isv, stream.id, isv.result, [syntax.error.msg FROM 0 FOR syntax.error.len])
                  write.string (from.isv, to.isv, stream.id, isv.result, " at line ")
                  write.int    (from.isv, to.isv, stream.id, isv.result, line.number, 0)
                  write.nl     (from.isv, to.isv, stream.id, isv.result)
            
              last.command <> 99
                SEQ
                  write.string.nl (from.isv, to.isv, stream.id, isv.result, "END_DEF NOT FOUND")
                  wait.any.event  (from.isv, to.isv, stream.id, isv.result)
            
              int (robot.def[2]) < 1
                SEQ
                  write.string.nl (from.isv, to.isv, stream.id, isv.result, "NOT ENOUGH JOINTS WERE DEFINED")
            
              TRUE
                SKIP
             
        TRUE
          SKIP
      
       
       
       
      {{{  Create the window
      load.dll (from.isv, to.isv, "C:\PROJECTS\WISERVER\GRAPHWIN.DLL",
                dll.index, dll.handle, isv.result)
      open.graphic.window (from.isv, to.isv, dll.index,
                           100, 100, 500, 500, "test", window.id, isv.result)
       
      {{{  Move the joints
      clock ? time
      SEQ i = 0 FOR int (robot.def[2]) + 1  -- Go through all the joints and then all at once. --
        SEQ j = 0 FOR 3                     -- Move three times per joint. --
          SEQ k = 0 FOR 36                  -- Go through the joint range (360 degrees in 10 degree steps). --
            SEQ
              {{{  Calculate joint value
              #USE snglmath
              INT joint1, joint2:
              SEQ
                {{{  Choose which joint
                IF
                  i = int (robot.def[2])
                    SEQ
                      joint1 := 0
                      joint2 := int (robot.def[2])
                  TRUE
                    SEQ
                      joint1 := i
                      joint2 := 1
                 
                SEQ j = joint1 FOR joint2
                  REAL32 min, max, average, half, n:
                  SEQ
                    min     := joint.values[j][1]
                    max     := joint.values[j][2]
                    average := (min + max) / 2.0 (REAL32)
                    half    := (max - min) / 2.0 (REAL32)
                    n       := SIN (((REAL32 ROUND (k*10)) / 180.0 (REAL32)) * PI)
                    joint.values[j][0] := average + (n * half)
               
              no.of.3D.lines := 0
              generate.robot.image (lines.3D, no.of.3D.lines, robot.def, joint.values)
              {{{  Pause
              clock ? AFTER time
              clock ? time
              time := time PLUS 500
               
              clear.all.graphic.lines (from.isv, to.isv,
                                       dll.index, window.id, isv.result)
              add.3D.lines (from.isv, to.isv, dll.index, window.id,
                            [lines.3D FROM 0 FOR no.of.3D.lines], ZOOM, ANGLE,
                            lines.left, isv.result)
       
    
      wait.any.event (from.isv, to.isv, stream.id, isv.result)
      clear.all.graphic.lines (from.isv, to.isv,
                               dll.index, window.id, isv.result)
      {{{  Close the window
      close.graphic.window (from.isv, to.isv, dll.index, window.id, isv.result)
      unload.dll (from.isv, to.isv, dll.index, isv.result)
       
     
    exit.server (from.isv, to.isv, SPS.SUCCESS)
:
F
...F code HT8
--:::F xhcsow08.dcd
...F descriptor
--:::F xhcsow08.dds
...F link
--:::F xhcsow08.dlk
...F debug
--:::F xhcsow08.ddb
...F CODE SC code
--:::F xhcsow08.csc
 

PLACED PAR
  PROCESSOR 0 T8
    PLACE to.isv   AT 0:
    PLACE from.isv AT 4:
    SEQ
      code (from.isv, to.isv)


F
...F code HT4
--:::F esonne08.dcd
...F descriptor
--:::F esonne08.dds
...F CODE PROGRAM Manipulator demo
--:::F esonne08.cpr
 
 
