home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
logo
/
powerlogo
/
utilities
/
system
< prev
next >
Wrap
Text File
|
1992-11-10
|
5KB
|
163 lines
; ********************************************************************
; 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 ]
]