home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 2: Collection B / 17Bit_Collection_B.iso / files / 1843.dms / in.adf / Mandelbrot / VariScreen.jf < prev   
Encoding:
Text File  |  1992-03-31  |  6.1 KB  |  264 lines
  1. \ Copyright 1989 NerveWare
  2. \ No portion of this code may used for commercial purposes,
  3. \ nor may any executable version of this code be disributed for 
  4. \ commercial purposes without the author's express written permission.
  5. \ This code is shareware, all rights reserved.
  6.  
  7. \ Nick Didkovsky
  8. \ 2/9/89
  9. \ open a screen with variable parameters
  10. \ Ultimately used by Mandelbrot generator.
  11.  
  12. \ MOD: close.mandelscreen safe, checks window and screen first        2/17/89
  13. \ MOD: color cycle takes mandel-num-colors into account                 2/17/89
  14. \ MOD: cycle-speed used to pause in cycle.colors.once            2/18/89
  15. \ MOD: fixed sneaky bug in shift.colors.once that clobbered dictionary  2/18/89
  16.  
  17. getmodule includes
  18.  
  19. include? ..! ju:c_struct
  20. include? value ju:value
  21. include? msec ju:msec
  22. include? newwindow.setup ju:amiga_graph
  23. include? ?closebox ju:amiga_events
  24. include? newscreen.setup ju:screen_support
  25. include? HIRES ji:graphics/view.j
  26.  
  27. anew task-vari_screen
  28.  
  29. decimal
  30.  
  31. NewScreen MandelScreen
  32. NewWindow MandelWindow
  33. Colormap MandelColorMap
  34.  
  35. \ next four vars determine screen resolution and number of colors
  36.  
  37. VARIABLE mandel-width
  38. VARIABLE mandel-height
  39. VARIABLE mandel-depth
  40. VARIABLE mandel-num-colors
  41.  
  42. VARIABLE mandel-view-flags
  43. VARIABLE mandel-variables-inited?
  44. VARIABLE cycle-speed
  45.  
  46. mandel-variables-inited? off 
  47.  
  48. VARIABLE Mscreen-ptr
  49. VARIABLE SavedColorTable 64 allot
  50.  
  51. CREATE MandelColorTable 
  52. $ 000 w, $ f00 w, $ f10 w, $ f20 w, 
  53. $ f30 w, $ f40 w, $ f50 w, $ f60 w, 
  54. $ f70 w, $ f80 w, $ f90 w, $ fa0 w, 
  55. $ fb0 w, $ fc0 w, $ fd0 w, $ fe0 w, 
  56. $ ff0 w, $ 00f w, $ 10f w, $ 20f w, 
  57. $ 30f w, $ 40f w, $ 50f w, $ 60f w, 
  58. $ 70f w, $ 80f w, $ 90f w, $ a0f w, 
  59. $ b0f w, $ c0f w, $ d0f w, $ e0f w, 
  60.  
  61. MandelColorTable SavedColorTable 64 MOVE
  62.  
  63. : BUILD.COLOR.MAP
  64.   mandel-num-colors @ MandelColorMap ..! cm_count
  65.   MandelColorTable >abs MandelColorMap ..! cm_colortable
  66. ;
  67.  
  68.  
  69. \ Call LoadRGB4 to set custom color map!
  70. : SET.COLOR.MAP
  71. \ get current viewport ptr
  72.   gr-curwindow @ >abs call intuition_lib ViewPortAddress 
  73. \  MandelColorMap >abs over ( -- vp Colortable vp )
  74. \  ..! vp_ColorMap    ( -- vp)
  75.   MandelColorTable >abs  ( use my new colors)
  76.   mandel-num-colors @                     ( variable number of new pens)
  77.   callvoid graphics_lib LoadRGB4
  78. ;
  79.  
  80. \ color table is always a 64 MOVE, even if we only use the first half in hires
  81. : RESTORE.COLOR.TABLE
  82.   SavedColorTable MandelColorTable 64 move
  83.   set.color.map
  84. ;
  85.  
  86. : SET.320x200 ( -- )
  87.  320 mandel-width !
  88.  200 mandel-height !
  89.  5 mandel-depth !
  90.  32 mandel-num-colors !
  91.  NULL mandel-view-flags !
  92.  mandel-variables-inited? on
  93. ;
  94.  
  95. : SET.640x400 ( -- )
  96.  640 mandel-width !
  97.  400 mandel-height !
  98.  4 mandel-depth !
  99.  16 mandel-num-colors !
  100.  HIRES LACE | mandel-view-flags !
  101.  mandel-variables-inited? on
  102. ;
  103.  
  104. : SET.320x400 ( -- )
  105.  320 mandel-width !
  106.  400 mandel-height !
  107.  5 mandel-depth !
  108.  32 mandel-num-colors !
  109.  LACE mandel-view-flags !
  110.  mandel-variables-inited? on
  111. ;
  112.  
  113. : OPEN.MANDELSCREEN ( -- )
  114.      mandel-variables-inited? @ not 
  115.      IF cr ." RESOLUTION DEFAULTING TO LORES" cr set.320x200 THEN
  116.      gr.init
  117. \ Set to default values.
  118.      MandelScreen NewScreen.Setup
  119.      MandelWindow NewWindow.Setup
  120. \
  121. \ Modify defaults
  122.      mandel-view-flags @ MandelScreen ..! ns_viewmodes
  123.      mandel-depth @ MandelScreen ..! ns_depth
  124.      0"    Didkovsky's Mandelbrot Generator" >abs
  125.          MandelScreen ..! ns_DefaultTitle
  126.      mandel-width @ MandelScreen ..! ns_Width
  127.      mandel-height @ MandelScreen ..! ns_Height
  128. \
  129. \ Open Screen and store pointer in NewWindow structure.
  130.      MandelScreen openscreen() dup Mscreen-ptr !  ( Open screen. )
  131.      >abs MandelWindow ..! nw_screen   ( Modify window for this screen. )
  132. \
  133. \ Set up Backdrop window.
  134.      CUSTOMSCREEN   MandelWindow ..! nw_type
  135.      0    MandelWindow ..! nw_TopEdge
  136.      0    MandelWindow ..! nw_LeftEdge
  137.      mandel-width @  MandelWindow ..! nw_Width
  138.      mandel-height @ MandelWindow ..! nw_Height
  139.      0" " >abs 
  140.      MandelWindow ..! nw_title ( no title PLEASE!)
  141.      REPORTMOUSE BACKDROP | BORDERLESS |  ACTIVATE | 
  142.                  MandelWindow ..! nw_flags
  143.       CLOSEWINDOW MENUPICK | MOUSEBUTTONS | MOUSEMOVE |
  144.                  MandelWindow ..! nw_IDCMPFlags
  145.      MandelWindow gr.openwindow gr.set.curwindow
  146. \  load new color map
  147.      build.color.map
  148.      set.color.map
  149.  
  150.     RemakeDisplay()
  151. ;
  152.  
  153. : CLOSE.MANDELSCREEN ( -- , Close screen and window.)
  154.     gr-curwindow @ IF gr.closecurw THEN
  155.     Mscreen-ptr @ ?dup
  156.     IF closescreen()  Mscreen-ptr off
  157.     THEN
  158. ;
  159.  
  160. : CLEAR.MANDELSCREEN
  161.   gr-currport @
  162.   0 ( background color)
  163.   call graphics_lib SetRast
  164.   drop ( don't need return value)
  165. ;  
  166.  
  167.  
  168. VARIABLE temp-color ( hold color #31)
  169.  
  170. : PRINT.COLOR.TABLE
  171.   MandelColorTable
  172.   32 0 do
  173.      dup i 2* + w@  . cr
  174.   loop
  175.   drop
  176. ;
  177.  
  178. : SHIFT.COLORS.ONCE  ( -- )
  179.   MandelColorTable >r ( -r- color_table_addr)
  180.   r@ mandel-num-colors @ 1- 2* + w@                ( -- color-31 | 15)
  181.   r@ 2+ dup 2+ mandel-num-colors @ 2- 2* move      ( -- color-31 | 15)
  182.   r> 2+ w!
  183. ;
  184.  
  185. : CYCLE.COLORS.ONCE
  186.   shift.colors.once
  187.   set.color.map
  188.   cycle-speed @ msec
  189. ;
  190.  
  191. \ ********************************** TESTS ********************************
  192.   
  193. : TEST.COLOR.MAP
  194.   gr-curwindow @ >abs call intuition_lib ViewPortAddress ( get current viewport ptr)
  195.   ..@ vp_ColorMap ..@ cm_ColorTable
  196. ;
  197.  
  198. \ test color map
  199.  
  200. : ALLDRAW
  201. mandel-height @ 0  do
  202.   0 i gr.move
  203.   i mandel-num-colors @ mod gr.color!
  204.   mandel-width @ i gr.draw
  205. loop
  206. ;
  207.  
  208. : ALLDRAW2
  209.   mandel-width @ 0 do
  210.     i 0 gr.move
  211.     i mandel-num-colors @ mod gr.color!
  212.     i mandel-height @ gr.draw
  213.   loop
  214. ;
  215.  
  216. : RECT.TEST
  217.    mandel-width @ 10 / 0 do
  218.      i gr.color!
  219.      i 10 * 0 gr.move
  220.      i 10 * 0 i 10 * 10 + mandel-height @ gr.rect
  221.   loop
  222. ;
  223.        
  224. : TEST.SCREEN
  225.   0 cycle-speed !
  226.   open.MandelScreen
  227.   200 msec
  228.   mscreen-ptr @ false showtitle()
  229.   clear.mandelscreen
  230.   alldraw
  231.   128 0 do
  232.       Cycle.Colors.Once
  233.       1 msec
  234.   loop
  235.   restore.color.table
  236.   500 msec
  237.   alldraw2
  238.   256 0 do
  239.       Cycle.Colors.Once
  240.       1 msec
  241.   loop
  242.   restore.color.table
  243.   500 msec
  244.   rect.test
  245.   500 msec
  246.   128 0 do
  247.       Cycle.Colors.Once
  248.       1 msec
  249.   loop
  250.   restore.color.table
  251.   Close.MandelScreen
  252. ;
  253.  
  254. : TEST.ALL.RESOLUTIONS ( -- )
  255.   set.320x200
  256.   test.screen
  257.   set.320x400
  258.   test.screen
  259.   set.640x400
  260.   10 cycle-speed !
  261.   test.screen
  262. ;
  263.  
  264.