home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / jx4nt125 / utils / yiqing.utf (.txt) < prev   
Encoding:
Null Bytes Alternating  |  1995-05-19  |  4.2 KB  |  99 lines
  1. \ YiQing.utf .. Yi Qing Oracle Jax4th NT Version
  2. \ Copyright (c) 1990, 1994 Jack J. Woehr
  3. \ P.O. Box 51, Golden, Colorado 80402-0051
  4. \ jax@well.sf.ca.us 72203.1320@compuserve.com
  5. \ SYSOP RCFB (303) 278-0364 2400/9600/14400
  6. \ All Rights Reserved
  7. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. \ This is free software and can be modified and redistributed under
  9. \ certain conditions described in the file COPYING.TXT. The
  10. \ Disclaimer of Warranty and License for this free software are also
  11. \ contained in the file COPYING.TXT.
  12. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  13.  
  14. \
  15. \ $Revision: 1.1 $
  16. \
  17.  
  18. \ ~~~~~~~~~~~~~~~~~~~~
  19. \ Conditional INCLUDED
  20. \ ~~~~~~~~~~~~~~~~~~~~
  21.  
  22. : PROVIDES ( c-addr u "ccc< >" --)
  23.     BL WORD FIND NIP 0=
  24.     IF INCLUDED ELSE 2DROP THEN ;
  25.  
  26. S" UTILS\UTILS.UTF" PROVIDES USEFUL
  27. S" UTILS\SYSCALLS.UTF" PROVIDES LIBRARY
  28.  
  29.  
  30.  
  31. CR .( Loading Yi Qing Oracle words) CR
  32.  
  33. USEFUL
  34.  
  35. : NOT INVERT ;
  36.  
  37. USEFUL INTERNALS-WORDLIST ALSO-WID DEFINITIONS
  38. HEX
  39.  
  40. S" GetSystemTime" KERNEL32 SYSTEMCALL GETSYSTIME
  41. CREATE _sysTime 4 CELLS ALLOT
  42.  
  43. : SYSTEMTIME (  --)
  44.     OPEN-ALL RESOLVE-ALL
  45.     _sysTime DATATOABS GETSYSTIME 2DROP
  46.     CLOSE-ALL
  47. ;
  48.  
  49.  
  50. SYSTEM-WORDLIST ALSO-WID DEFINITIONS
  51.  
  52. \ ~~~~~~~~~~~~~~~
  53.  
  54. MARKER yiqing.utf
  55.  
  56. \ ~~~~~~~~~~~~~~~
  57. \ We can always forget back to here.
  58. \ It's not safe to forget back past GETSYSTIME
  59. \ because of the linked lists involved in our syscall
  60. \ scheme.
  61.  
  62. : SYSTEMTIME ( -- wYear wMonth wDoW wDay wHr wMin wSec wMsec)
  63.     SYSTEMTIME
  64.     8 0
  65.     DO
  66.         I CHARS _sysTime + C@
  67.     LOOP
  68. ;
  69.  
  70. USEFUL HEX
  71.  
  72. 2 CONSTANT YIN 3 CONSTANT YANG
  73.  
  74. : YIN? YANG MOD 0= NOT ;
  75. : YANG? YIN MOD ;
  76.  
  77. : STALK DUP YANG? SWAP YIN? ;
  78. : YARROW ABS 4 MOD 6 + ;
  79.  
  80. : RIGHTEOUS YARROW STALK ;
  81.  
  82. : PLACES
  83.    8 SPACES DUP ." ***"
  84.    IF ." ***" ELSE 3 SPACES THEN ." ***" ;
  85.  
  86. : BREAKS
  87.    3 SPACES SWAP
  88.    IF DROP ELSE IF ." -0-" ELSE ." -X-" THEN THEN ;
  89.  
  90. : CAST KEY SYSTEMTIME + + + + + + + + ;
  91.  
  92. : READING PLACES BREAKS CR ;
  93.  
  94. : ORACLE CR CR 6 0 DO CAST RIGHTEOUS READING LOOP ;
  95.  
  96. DECIMAL
  97.  
  98. \ End of YiQing.utf
  99.