home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / vdi.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  3.9 KB  |  148 lines
  1. \ GEM VDI calling routines
  2. \
  3. \ This was written by Jesse Taylor.
  4. \ These may change or disappear in future versions (presumably to be
  5. \ replaced by something better).
  6.  
  7. decimal
  8. \ these are the parameter input and output array's to the vdi
  9.  
  10. create contrl-buf  26 allot
  11. create intin-buf  258 allot
  12. create ptsin-buf  512 allot
  13. create intout-buf 258 allot
  14. create ptsout-buf 258 allot
  15.  
  16. \ this is the parameter block that is passed to vdi in register d1
  17.  
  18. create vdi-block  contrl-buf , intin-buf , ptsin-buf ,
  19.           intout-buf , ptsout-buf ,  0 , 0 ,
  20.  
  21.  
  22. create aes-block  contrl-buf , intin-buf , ptsin-buf ,
  23.           intout-buf , ptsout-buf ,  0 , 0 ,
  24.  
  25. \ these are important variables.  take my word for it
  26. variable vhandle
  27.  
  28. \ these are some convenient routines for getting at the parameter array's
  29.  
  30. : contrl[]  ( n -- adr )  ( returns address of array element )
  31.    contrl-buf swap wa+
  32. ;
  33. : intin[]  ( n -- adr )  ( returns address of array element )
  34.    intin-buf swap wa+
  35. ;
  36. : ptsin[]  ( n -- adr )  ( returns address of array element )
  37.    ptsin-buf swap wa+
  38. ;
  39. : intout[]  ( n -- adr )  ( returns address of array element )
  40.    intout-buf swap wa+
  41. ;
  42. : ptsout[]  ( n -- adr )  ( returns address of array element )
  43.    ptsout-buf swap wa+
  44. ;
  45.  
  46. \ these are some higher level parameter array setting routines
  47.  
  48.  
  49. : !pba-intin  ( adr -- )  ( set pba to point too new address )
  50.    vdi-block 4 + !
  51. ;
  52. : !pba-ptsin  ( adr -- )  ( set pba to point too new address )
  53.    vdi-block 8 + !
  54. ;
  55. : !pba-intout  ( adr -- )  ( set pba to point too new address )
  56.    vdi-block 12 + !
  57. ;
  58. : !pba-ptsout  ( adr -- )  ( set pba to point too new address )
  59.    vdi-block 16 + !
  60. ;
  61. : contrl!  ( n1 n2 -- )  ( store n1 into n2 item in the contrl[] array )
  62.    contrl[] w!
  63. ;
  64. : contrl@  ( n1 -- n2 )  ( fetch n1 item from the contrl[] array )
  65.    contrl[] w@
  66. ;
  67. : set-op  ( n -- )  ( set contrl[0] which holds the current vdi function # )
  68.    contrl-buf  w!
  69. ;
  70. : ptsin!  ( x y n -- )  ( store x y coordinate into n'th item in ptsin[] )
  71.    tuck  1+ ptsin[] w!  ptsin[] w!
  72. ;
  73. : ptsout@  ( n -- x y )  ( get x y coordinate from n'th item in ptsout[] )
  74.    dup  ptsout[] w@  swap  1+  ptsout[] w@
  75. ;
  76. : intin!  ( n1 n2 -- )  ( store n1 into the n2 item in the intin array )
  77.    intin[] w!
  78. ;
  79. : intout@  ( n1 -- n2 )  ( fetch n2 from the n1 item in the intout array )
  80.    intout[] w@
  81. ;
  82. : #ptsin!  ( n -- )  ( store number into contrl[1] )
  83.    1 contrl!
  84. ;
  85. : #intin!  ( n -- )  ( store number into contrl[3] )
  86.    3 contrl!
  87. ;
  88. : #ptsinoff  ( -- )  ( zero the intin value in the contrl array )
  89.    0 #ptsin!
  90. ;
  91. : #intinoff  ( -- )  ( zero the intin value in the contrl array )
  92.    0 #intin!
  93. ;
  94. : #pt-intinoff  ( -- )  ( turn both intin and ptsin values off )
  95.    #intinoff  #ptsinoff
  96. ;
  97. : #dev!  ( n -- )  ( set the device pointer in the contrl array )
  98.    6 contrl!
  99. ;
  100. : set-device  ( -- )  ( store the current vdi device handle into contrl[6] )
  101.    vhandle @  #dev!
  102. ;
  103.  
  104. \ this is the vdi calling routine
  105.  
  106. code callvdi  ( -- )  ( call vdi from forth )
  107.    a3 sp -) lmove a4 sp -) lmove   a5 sp -) lmove   a6 sp -) lmove
  108.    vdi-block  l# d1 lmove
  109.    decimal 115 # d0 wmove decimal
  110.    2 trap
  111.    sp )+ a6 lmove   sp )+ a5 lmove   sp )+ a4 lmove   sp )+ a3 lmove
  112. c;
  113.  
  114. code callaes  ( -- )  ( call aes from forth )
  115.    a3 sp -) lmove a4 sp -) lmove   a5 sp -) lmove   a6 sp -) lmove
  116.    aes-block  l# d1 lmove
  117.    hex 0c8 # decimal d0 wmove 
  118.    2 trap
  119.    sp )+ a6 lmove   sp )+ a5 lmove   sp )+ a4 lmove   sp )+ a3 lmove
  120. c;
  121.  
  122. decimal
  123. : appl_init  ( -- id )  ( initializes you gem application )
  124.    10 0 contrl[] w!  1 2 contrl[] w!  0 1 contrl[] w!  0 3 contrl[] w!
  125.    callaes  0 intout@
  126. ;
  127.  
  128. : open-virt
  129.    100 set-op
  130.    0 1 contrl!
  131.    11 3 contrl!
  132.    1 6 contrl!
  133.    1 0 intin!
  134.    9 1
  135.    do  1 i intin!   loop
  136.    2 10 intin!
  137.    callvdi
  138.    6 contrl[] w@  vhandle !
  139. ;
  140.  
  141. : close-virt
  142.    101 set-op
  143.    0 1 contrl!
  144.    0 3 contrl!
  145.    set-device
  146.    callvdi
  147. ;
  148.