home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / logo / powerlogo / libs / intuit < prev    next >
Text File  |  1993-01-25  |  3KB  |  167 lines
  1.  
  2. ; intuit -- easy access to intuition info, especially windows
  3. ; Tony L Belding
  4.  
  5. if buriedp "intuitnames [ unbury :intuitnames ] [ ]
  6.  
  7.  
  8. make "closescreens [
  9.     procedure [ ]
  10.  
  11.     ; close all Logo graphics screens
  12.     while [ not emptyp screenlist ] [
  13.         closescreen first screenlist
  14.     ]
  15. ]
  16.  
  17. make "closewindows [
  18.     procedure [ ]
  19.  
  20.     ; close all Logo windows
  21.     while [ not emptyp windowlist ] [
  22.         closewindow first windowlist
  23.     ]
  24. ]
  25.  
  26. make "screen-pens [
  27.     procedure [ [ :sc ] ]
  28.  
  29.     ; return number of colors/pens on a screen
  30.     op power 2 ( peek 1 :sc 189 )
  31. ]
  32.  
  33. make "screen-position [
  34.     procedure [ [ :sc ] ]
  35.  
  36.     ; return a list with the position of a given screen
  37.     op se ( peek 2 :sc 4 ) ( peek 2 :sc 5 )
  38. ]
  39.  
  40. make "position-screen [
  41.     procedure [ [ :sc :pos ] ]
  42.  
  43.     ; move a screen to a given position, takes position as a list
  44.     ( intuition 1 :sc first :pos item 2 :pos )
  45. ]
  46.  
  47. make "screen-size [
  48.     procedure [ [ :sc ] ]
  49.  
  50.     ; return a list with the horizontal and vertical size of a screen
  51.     op se ( peek 2 :sc 6 ) ( peek 2 :sc 7 )
  52. ]
  53.  
  54. make "screen-wlist [
  55.     procedure [ [ :sc ] [ ] [ :firstw ] ]
  56.  
  57.     ; returns a list of windows open on a given screen
  58.  
  59.     if not memberp :sc screenlist [ stop ] [ ]
  60.     make "firstw word "@ ( peek 4 :sc 1 )
  61.     if = "@0 :firstw [
  62.         op [ ]
  63.     ] [
  64.         op se :firstw digwlst :firstw
  65.     ]
  66.     ]
  67.     make "digwlst [
  68.     procedure [ [ :wi ] [ ] [ :nextw ] ]
  69.     make "nextw word "@ peek 4 :wi
  70.     if = "@0 :nextw [
  71.         op [ ]
  72.     ] [
  73.         op se :nextw digwlst :nextw
  74.     ]
  75. ]
  76.  
  77. make "window-position [
  78.     procedure [ [ :wi ] ]
  79.  
  80.     ; return the [ x y ] position of a given window
  81.     op se ( peek 2 :wi 2 ) ( peek 2 :wi 3 )
  82. ]
  83.  
  84. make "position-window [
  85.     procedure [ [ :wi :pos ] ]
  86.  
  87.     ; move a window to a given [ x y ] position
  88.     ( intuition 2 :wi first :pos item 2 :pos )
  89. ]
  90.  
  91. make "center-window [
  92.     procedure [ [ :wi ] [ ] [ :parsiz :windsiz ] ]
  93.     ; it do what it say
  94.    make "parsiz screen-size window-parent :wi
  95.    make "windsiz window-size :wi
  96.    position-window :wi se ( / - first :parsiz first :windsiz 2 )
  97.                           ( / - last :parsiz last :windsiz 2 )
  98. ]
  99.  
  100. make "window-size [
  101.     procedure [ [ :wi ] ]
  102.  
  103.     ; return the [ x y ] size of a given window
  104.     op se ( peek 2 :wi 4 ) ( peek 2 :wi 5 )
  105. ]
  106.  
  107. make "size-window [
  108.     procedure [ [ :wi :size ] ]
  109.  
  110.     ; resize a window to [ x y ] dimensions
  111.     ( intuition 8 :wi first :size item 2 :size )
  112. ]
  113.  
  114. make "window-parent [
  115.     procedure [ [ :wi ] ]
  116.  
  117.     ; return a pointer to the screen a window is open on
  118.     op firstput "@ ( peek 4 :wi 11.5 )
  119. ]
  120.  
  121. make "fronts [
  122.     procedure [ [ :sc ] ]
  123.  
  124.     ; move a screen to the front
  125.     intuition 6 :sc
  126. ]
  127.  
  128. make "backs [
  129.     procedure [ [ :sc ] ]
  130.  
  131.     ; move a screen to the back
  132.     intuition 5 :sc
  133. ]
  134.  
  135. make "frontw [
  136.     procedure [ [ :wi ] ]
  137.  
  138.     ; move a window to the front
  139.     intuition 11 :wi
  140. ]
  141.  
  142. make "backw [
  143.     procedure [ [ :wi ] ]
  144.  
  145.     ; move a window to the back
  146.     intuition 10 :wi
  147. ]
  148.  
  149. make "clearw [
  150.     procedure [ [ :wi ] [ ] [ :turt ] ]
  151.  
  152.     ; clear graphics from a given window
  153.     make "turt openturtle :wi
  154.     ( clean :turt )
  155.     closeturtle :turt
  156. ]
  157.  
  158. make "intuit [ procedure [ ] ]
  159.  
  160. make "intuitnames [ intuitnames closescreens closewindows screen-pens
  161.     screen-position position-screen digwlst screen-size screen-wlist
  162.     window-position position-window window-size size-window
  163.     window-parent fronts backs frontw backw clearw intuit ]
  164.  
  165. bury :intuitnames
  166.  
  167. ; end of listing