home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_GEN / FORTH_86.ZIP / HILCOM.DEM < prev    next >
Text File  |  1993-10-23  |  2KB  |  69 lines
  1. brkon
  2. OFF PRINTLOAD
  3.  
  4. LAST @ " -- LAST" ." .H 5 spcs
  5. HEAD @ " -- HEAD" ." .H 5 spcs
  6. HEAD @ " -- HEAD" ." .H 5 spcs 
  7.  
  8. iload apps.img " apps.img loaded" ." crlf 
  9.  
  10. LAST @ " -- LAST" ." .H 5 spcs
  11. HEAD @ " -- HEAD" ." .H 5 spcs
  12. HEAD @ " -- HEAD" ." .H 5 spcs 
  13.  
  14. fload hilsier2.4th  ( " 7hilsier2 loaded" ." crlf  )
  15.  
  16.  : saymore crlf  5 spcs
  17.            " If you want to try this in greater depth" ." crlf 5 spcs
  18.            " use 4TH_86FP.COM and type FLOAD HILSIER.4TH" ."  crlf 5 spcs
  19.            crlf " Then you can put in parameters " ." crlf crlf
  20.            " such as  3 2 HILB   or  3 2 SIERP " ." crlf crlf
  21.              " where 3 is number of levels and 2 is magnification" ." crlf
  22.              " (best to keep magnification at 1 usually " ." crlf crlf
  23.              " in which case you need only type 3 HILB or 6 SIERP) " ."
  24.         crlf crlf 5 spcs " Larry Buchan" ." ;
  25.  
  26. : doit 3 secdelay  hilb 5 secdelay  sierp 5 secdelay  norm saymore 
  27.    crlf crlf 10 secdelay ;
  28.  
  29. ( define a constant that is the def adr of the last word)
  30. LAST @ 2DUPB@ + 2+ 2@ CONST ENTRYPOINT
  31.  
  32.  : MYPROGRAM  crlf  5 spcs
  33.            " This is a demonstration 4th_86  PROGRAM" ." crlf 5 spcs
  34.            " of Hilbert and Sierpin curves " ."  crlf 5 spcs
  35.            crlf " W A I T ====> " ." crlf crlf
  36.            " each picture lasts 5  seconds " ." ;
  37.  
  38.  
  39. : BOOT  ( bootstrap)
  40.   3000h setmem brkoff 0 ivpage ! norm myprogram crlf crlf ENTRYPOINT EXEC 
  41.         bye ;
  42.  
  43. 1000 ( 128)  CONST SYSIZE    ( stack space for program)
  44. '' SYSIZE BLOCK SYSTK ( define stack)
  45.  
  46.  100H
  47.  CODE GOFORTH
  48.   HEAD @ SWAP GETLOC SWAP ORG jmp tos ( JMP, ) HEAD !
  49.   ( THIS PATCHED THE STARTUP JUMP INTO THE GIVEN LOC.)
  50.  
  51.   ( SP ) '' SYSTK '' SYSIZE + 10 - ( LXI, ) mov sp,tos ( SET SP)
  52.   ( H ) '' SYSTK ( LXI, ) mov bx,tos ( '' CSP SHLD, )
  53.         ( df89h head! ) mov di,bx ( SET CSP) 
  54.  
  55.   :ENTER BOOT  ( enter forth and execute user bootstrap)
  56. ; 
  57.  
  58. " hilmap" map
  59.  
  60. STATUS ( print code size)
  61.  
  62.         " hilbert.COM" SAVE
  63.  " HILBERT.COM written ^13 10^ " ." 
  64.  
  65. bye
  66.  
  67. ( q-u-it )
  68.  
  69.