;  ********************************************************************
;  Graphics Utilities
;  ********************************************************************

make "screen-data [
   procedure [ [ :sd-screen ] [ ] [ :f ] ]
   if = @0 :sd-screen [ make "sd-screen system 16 ] [ ]
   make "f ( peek 2 :sd-screen 38 )
   output ( list  ( +   if bitsetp 15 :f [ 1 ] [ 0 ]
                        if bitsetp 2 :f [ 2 ] [ 0 ]
                        if bitsetp 7 :f [ 4 ] [ 0 ] )
                  ( peek 1 :sd-screen 189 )
                  convertstring ( peek 0 :sd-screen 6.5 )
                  ( peek -2 :sd-screen 4 )
                  ( peek -2 :sd-screen 5 )
                  ( peek -2 :sd-screen 6 )
                  ( peek -2 :sd-screen 7 )
                  ( peek 1 :sd-screen 330 )
                  ( peek 1 :sd-screen 331 ) ) ]

make "window-data [
   procedure [ [ :wd-window ] [ ] [ :f :s ] ]
   if = @0 :wd-window [ make "wd-window system 15 ] [ ]
   make "s ( peek 0 :wd-window 11.5 )
   make "f ( peek 4 :wd-window 6 )
   output ( list  if = :s system 16 [ @0 ] [ :s ]
                  ( +   if bitsetp 1 :f [ 1 ] [ 0 ]
                        if bitsetp 2 :f [ 2 ] [ 0 ]
                        if bitsetp 3 :f [ 4 ] [ 0 ]
                        if bitsetp 0 :f [ 8 ] [ 0 ]
                        if bitsetp 10 :f [ 16 ] [ 0 ]
                        if bitsetp 8 :f [ 32 ] [ 0 ]
                        if bitsetp 11 :f [ 64 ] [ 0 ]
                        if bitsetp 13 :f [ 128 ] [ 0 ] )
                  convertstring ( peek 0 :wd-window 8 )
                  ( peek -2 :wd-window 2 )
                  ( peek -2 :wd-window 3 )
                  ( peek -2 :wd-window 4 )
                  ( peek -2 :wd-window 5 )
                  ( peek 1 :wd-window 98 )
                  ( peek 1 :wd-window 99 )
                  ( peek -2 :wd-window 8 )
                  ( peek -2 :wd-window 9 )
                  ( peek -2 :wd-window 10 )
                  ( peek -2 :wd-window 11 ) ) ]

make "turtle-data [
   procedure [ [ :td-turtle ] [ ] [ :f ] ]
   make "f ( peek 2 :td-turtle 40 )
   output ( list  ( peek 0 :td-turtle 1 )
                  ( peek 8 :td-turtle 3 )
                  /  +- ( peek 8 :td-turtle 4 )
                     ( peek 8 :td-turtle 3 )
                  ( peek 8 :td-turtle 5 )
                  ( peek 8 :td-turtle 6 )
                  ( peek 8 :td-turtle 7 )
                  if bitsetp 3 :f [ -1 ] [ 0 ] ) ]

make "bitsetp [
   procedure [ [ :bs-bit :bs-data ] [ ] [ :t ] ]
   make "t 2147483648
   while [ < :bs-bit 31 ]
   [  if >= :bs-data :t [ make "bs-data - :bs-data :t ] [ ]
      make "t / :t 2
      inc "bs-bit ]
   output >= :bs-data :t ]

; WINDOW-SIZE **********************************************************
;    Output the limits for the cursor for the command window.

make "window-size [
  procedure [ [ ] [ ] [ :_ws_pos :_ws_lim ] ]
  make "_ws_pos cursor
  setcursor [ 10000 10000 ]
  make "_ws_lim cursor
  setcursor :_ws_pos
  op list + first :_ws_lim 1 + last :_ws_lim 1 ]


;  ***************************************************************
;  ***   Requests
;  ***************************************************************

; *** Yes or no requester

make "requester [
   procedure [ [ :screen :q1-text ]
               [ :q2-text :yes-text :no-text :title-text ]
               [ :w :m :x ] ]
   while [ mousep ] [ ignore getmouse ]
   if emptyp :yes-text [ make "yes-text "YES ] [ ]
   if emptyp :no-text [ make "no-text "NO ] [ ]
   if emptyp :title-text [ make "title-text [ LOGO Request! ] ] [ ]
   make "w ( openwindow :screen 131 :title-text 0 0 240 52 )
   setpen :w 1
   rectfill :w 4 12 235 48
   setpen :w 0
   setdrmode :w 0
   move :w 8 20
   text :w :q1-text
   move :w 8 30
   text :w :q2-text
   move :w - 50 * 4 count :yes-text 43
   text :w :yes-text
   move :w - 189 * 4 count :no-text 43
   text :w :no-text
   drawbox :w 10 34 80 12
   drawbox :w 149 34 80 12
   while [ true ]
   [  make "m getmouse
      if = :w first :m
      [  make "x item 2 :m
         if >> 34 46 item 3 :m
         [  if >> 10 90 :x
            [  closewindow :w
               op true ]
            [  if >> 149 229 :x
               [  closewindow :w
                  op false ] [ ] ] ] [ ] ] [ ] ] ]
               
; *** alert 

make "alert [
   procedure [ [ :screen :q1-text ]
               [ :q2-text :yes-text :title-text ]
               [ :w :m ] ]
   while [ mousep ] [ ignore getmouse ]
   if emptyp :yes-text [ make "yes-text "OK ] [ ]
   if emptyp :title-text [ make "title-text [ LOGO Alert! ] ] [ ]
   make "w ( openwindow :screen 131 :title-text 0 0 240 52 )
   setpen :w 1
   rectfill :w 4 12 235 48
   setpen :w 0
   setdrmode :w 0
   move :w 8 20
   text :w :q1-text
   move :w 8 30
   text :w :q2-text
   move :w - 50 * 4 count :yes-text 43
   text :w :yes-text
   drawbox :w 10 34 80 12
   while [ true ]
   [  make "m getmouse
      if = :w first :m
      [  if >> 34 46 item 3 :m
         [  if >> 10 90 item 2 :m
            [  closewindow :w
               stop ] [ ] ] [ ] ] [ ] ] ]
               
; *** simple rectangle

if buriedp "drawbox [ ] [
make "drawbox [
   procedure [ [ :box-w :le :te :w :h ] ]
   move :box-w :le :te
   draw :box-w + :le :w :te
   draw :box-w + :le :w + :te :h
   draw :box-w :le + :te :h
   draw :box-w :le :te ]
]