home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / polygons.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  2.2 KB  |  81 lines
  1. \ Sliding polygons demo.  Load this file and type   poly-demo
  2. \ 
  3. \ Type any key to stop it.
  4. \
  5. \ The demo initially draws triangles.  By typing
  6. \    n vertices   poly-demo
  7. \ where 3 <= n < 64, you can change it to draw polygons with more vertices
  8.  
  9. needs rnd random.fth
  10. needs line-a-init linea.fth
  11. line-a-init
  12. decimal
  13.  5 xbios: _setscreen  { w.rez l.phyz l.log -- }
  14. 37 xbios: vsync { -- }  \ wait till next vertical retrace then return
  15.  
  16. scradr constant old-screen
  17. get-rez
  18. constant cury
  19. constant curx
  20.  
  21. create source-buff  256 allot
  22. create dest-buff  256 allot
  23. create spare-buff  256 allot
  24. create new-scr-buff  1024 32 * 512 + allot
  25. new-scr-buff 512 mod 512 swap - new-scr-buff + constant new-screen
  26. variable keep-going keep-going on
  27. variable #verts  3 #verts !
  28.  
  29. : set-buf  ( addr -- )  \ randomize a buffer
  30.    dup #verts @ 0
  31.    do   curx rnd  over w! 2+  cury rnd  over w! 2+   loop
  32.    over w@ over w! 2+ swap 2+ w@  swap w!
  33. ;
  34.  
  35. : move-buf  ( -- )  \ convert one buffer to another
  36.    dest-buff  source-buff  keep-going off  #verts @ 1+  2* 0
  37.    do
  38.      dup w@  2 pick w@  2dup 2dup <> -rot 1+ <> and
  39.       if   over  > 
  40.         if   2+
  41.         else 2-
  42.         then over w!  keep-going on
  43.       else 2drop
  44.       then 2+  swap  2+  swap
  45.    loop  2drop
  46. ;
  47. : draw-source ( -- )  \ draw the source polygon
  48.    source-buff #verts @  poly-line 
  49. ;
  50. : vertices  ( n -- )  \ set the number of vertices
  51.    #verts !
  52. ;
  53. : poly-demo
  54.    27 emit ascii f emit
  55.    -1 -1 new-screen _setscreen  erase-screen
  56.    -1 -1 old-screen _setscreen  erase-screen
  57.    2 _wrt_mod w!  
  58.    dest-buff set-buf  source-buff set-buf  
  59.    -1 new-screen old-screen _setscreen vsync draw-source  
  60.    -1 old-screen new-screen _setscreen vsync draw-source  
  61.    source-buff spare-buff  #verts @ 1+ 4 * cmove
  62.    begin
  63.     begin
  64.         -1 old-screen new-screen  _setscreen
  65.         spare-buff #verts @ vsync poly-line        
  66.         source-buff spare-buff  #verts @ 1+ 4 * cmove
  67.         move-buf  draw-source 
  68.  
  69.         -1 new-screen old-screen  _setscreen
  70.         spare-buff #verts @ vsync poly-line        
  71.         source-buff spare-buff  #verts @ 1+ 4 * cmove
  72.         move-buf  draw-source 
  73.         key?
  74.         if  -1 old-screen old-screen _setscreen
  75.             27 emit ascii e emit exit  
  76.         then
  77.           keep-going @ 0=
  78.     until  dest-buff set-buf 
  79.    again
  80. ;
  81.