Paste2 Logo
  1. | GUI 2.0
  2. | PHREDA - 2009
  3. |-----------------------------
  4. ^reda4.txt
  5. ^graflib.txt
  6.  
  7. #ygui #xgui
  8.  
  9. #boton  0
  10. #tocado 0
  11. #marca  0
  12. #tablamain
  13.  
  14. |--------pantalla
  15. :tabla1 | adr 1 -- adr+
  16.         swap @+ swap | w h adr
  17.         @+ w 16 *>> 'xc +!
  18.         @+ h 16 *>> 'yc +!
  19.         @+ >r | <===exec
  20.         swap h 16 *>> 'h !
  21.     swap w 16 *>> 'w !
  22.         xymouse whin 1? ( over 'tocado ! ) drop
  23.         ;
  24.  
  25. :dibujagui
  26.         0 'tocado !
  27.         bmouse boton =? ( 0 )( 1 ) nip 'marca !
  28.         tablamain
  29.         ( @+ 1? )( cursor.push tabla1 cursor.pop )
  30.         2drop ;
  31.  
  32. ::in? | -- 0/1?
  33.         tocado =? ( 1 )( 0 )
  34.         ;
  35.  
  36. ::down?
  37.         marca 0? ( ; ) drop
  38.         bmouse ;
  39. ::move?
  40.         marca 1? ( 0 nip ; ) drop
  41.         bmouse ;
  42. ::up?
  43.         marca 0? ( ; ) drop
  44.         bmouse not ;
  45.  
  46. :irqpen
  47.         xymouse 'ygui !+ ! ;
  48.  
  49. |=================================================
  50. #startime
  51.  
  52. ::.restart
  53.         msec 'startime ! ;
  54.  
  55. ::.segs | seg --
  56.         1000 *
  57. ::.mseg | seg --
  58.         msec startime - >? ( rdrop ) drop ;
  59.  
  60. :cursor1
  61.         bmouse 3 << 8 +
  62.         xymouse
  63.         over pick3 - over op over pick3 + over line
  64.         2dup pick4 - op rot + line ;
  65.  
  66. #dibujacursor 'cursor1
  67.  
  68. ::gcursor! | cur --
  69.         'dibujacursor ! ;
  70.  
  71. ::gshow | desc --
  72.         'tablamain !
  73. |       'irqpen
  74.         0 ipen!
  75.         0 '.exit !
  76.         bmouse 'boton !
  77.         msec 24 +
  78.         ( .exit 0? )( drop
  79.                 ( msec >? )( update )
  80.                 drop r msec 24 + >r | pila libre
  81.                 exec
  82.                 dibujagui
  83.                 dibujacursor 0? ( drop )( exec )
  84.                 redraw r> ) 2drop
  85.         0 '.exit !
  86.         ;
  87.  
  88. ::g.drag | down move up --
  89. |       in? 0? ( 4drop ; ) drop
  90.         marca 1? (
  91.                 bmouse 1? ( 4 drop exec ; ) drop
  92.                 2drop nip nip exec ; ) drop
  93.         bmouse 1? ( 2drop nip exec ; )
  94.         4drop ;
  95.  
  96. ::g.click | click --
  97.         ;
  98.  
  99.  

:r4 new gui system