10 ! *********************************************************************
20 ! Example: BITMAP Widget
30 !
40 ! This program demonstrates the use of the BITMAP widget. It
50 ! allows you to bring in and display bitmaps, as well as select
60 ! portions of them and save them in a file.
70 !
80 ! It also demonstrates the SCROLLABLE attribute for the PANEL,
90 ! such as the various operations needed to make SCROLL WIDTH
100 ! and SCROLL HEIGHT as correct as possible.
110 !
120 ! ***********************************************************
130 !
140 ! Variables used:
150 !
160 ! S$: General-purpose string
170 ! N: General-purpose variable
180 ! Btn: Returns button value from dialogs
190 ! Sc: Scroll factor
200 ! Bitfile$: Name of bitmap file to be read
210 ! Dirname$: Directory name returned from FILE dialog
220 ! B1$(*): Stores MENU BUTTONS
230 ! A1$,A2$: Stores dialog attributes
240 !
250 DIM S$[256]
260 INTEGER N,Btn,Sc
270 DIM Bitfile$[100],Dirname$[100],Btns$(1:3)[50],A1$[50],A2$[50]
280 !
290 DATA "BMP File","XWD File","Cancel","DIALOG BUTTONS","SELECTION",20
300 READ Btns$(*),A1$,A2$,Sc
310 !
320 ! Widget dimensions
330 !
340 INTEGER Pw,Ph,Px,Py,Iw,Ih,Ww,Wh,Wx,Wy
350 !
360 ! Variables for display scaling
370 !
380 INTEGER Cursor,D(1:4),Dw,Dh
390 !
400 ! Get display size
410 !
420 GESCAPE CRT,3;D(*)
430 Dw=D(3)-D(1)
440 Dh=D(4)-D(2)
450 !
460 CLEAR SCREEN
470 !
480 Pw=Dw*.7 ! PANEL width
490 Ph=Dh*.7 ! PANEL height
500 Px=(Dw-Pw)/2 ! Center PANEL
510 Py=(Dh-Ph)/2
520 !
530 ! Create PANEL for BITMAP widget. The SCROLL WIDTH and
540 ! HEIGHT are set to a small value so that scroll bars
550 ! will not appear initially. The actual heights are set
560 ! later to fit the bitmap that has been loaded.
570 !
580 ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
590 CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
600 CONTROL @Main;SET ("TITLE":" Example: BITMAP Widget")
610 CONTROL @Main;SET ("SIZE CONTROL":"SCROLLABLE","MINIMIZABLE":1)
620 CONTROL @Main;SET ("SCROLL WIDTH":1,"SCROLL WIDTH UNITS":Sc)
630 CONTROL @Main;SET ("SCROLL HEIGHT":1,"SCROLL HEIGHT UNITS":Sc)
640 !
650 ! Build menu
660 !
670 ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
680 CONTROL @Menu;SET ("LABEL":"Menu")
690 ASSIGN @Getfile TO WIDGET "MENU BUTTON";PARENT @Menu
700 CONTROL @Getfile;SET ("LABEL":"Get Bitmap File")
710 ASSIGN @Savefile TO WIDGET "MENU BUTTON";PARENT @Menu
720 CONTROL @Savefile;SET ("LABEL":"Cut Bitmap To File")
730 ASSIGN @Cd TO WIDGET "MENU BUTTON";PARENT @Menu
740 CONTROL @Cd;SET ("LABEL":"Change Directory")
750 ASSIGN @S TO WIDGET "MENU SEPARATOR";PARENT @Menu
760 ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
770 CONTROL @Quit;SET ("LABEL":"Quit")
780 !
790 ! Create and size BITMAP widget. (Setting RETAIN RASTER makes
800 ! the widget redraw quickly when overwritten by a dialog.)
810 !
820 ASSIGN @Bitmap TO WIDGET "BITMAP";PARENT @Main
830 CONTROL @Bitmap;SET ("RETAIN RASTER":1,"AUTO SIZE":1)
840 STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
850 Wx=Iw*.01
860 Wy=Ih*.01
870 Wh=Ih*.98
880 Ww=Iw*.98
890 CONTROL @Bitmap;SET ("X":Wx,"Y":Wy,"WIDTH":Ww,"HEIGHT":Wh)
900 !
910 ! Set events
920 !
930 ON EVENT @Getfile,"ACTIVATED" GOSUB Getbitfile
940 ON EVENT @Savefile,"ACTIVATED" GOSUB Savebits
950 ON EVENT @Cd,"ACTIVATED" GOSUB Chdir
960 ON EVENT @Quit,"ACTIVATED" GOTO Finis
970 !
980 CONTROL @Main;SET ("VISIBLE":1)
990 !
1000 ! Loop and wait for input
1010 !
1020 LOOP
1030 WAIT FOR EVENT
1040 END LOOP
1050 STOP
1060 !
1070 ! ************** End of Main Program **********************
1080 !
1090 ! This routine gets a bitmap file and displays it. It gets
1100 ! the bitmap size and sets up PANEL scrolling accordingly.
1110 ! Also, it makes the BITMAP widget invisible so the display
1120 ! will "thrash" as little as possible.
1130 !
1140 Getbitfile: !
1150 S$="Please enter the name of a bitmap (.XWD or .BMP) file:"
1160 DIALOG "FILE",S$,Btn;RETURN ("SELECTION":Bitfile$)
1170 !
1180 IF Btn=0 THEN
1190 CLEAR ERROR
1200 ON ERROR GOSUB Errtrap
1210 CONTROL @Bitmap;SET ("VISIBLE":0,"BITMAP FILE":Bitfile$)
1220 OFF ERROR
1230 IF ERRN<>0 THEN
1240 DIALOG "ERROR","Can't open file / invalid bitmap file."
1250 CONTROL @Bitmap;SET ("BITMAP FILE":"","VISIBLE":1)
1260 ELSE
1270 CONTROL @Bitmap;SET ("VISIBLE":0)
1280 STATUS @Bitmap;RETURN ("BITMAP HEIGHT":Wh,"BITMAP WIDTH":Ww)
1290 CONTROL @Main;SET ("SCROLL HEIGHT":2+INT(Wh/Sc))
1300 CONTROL @Main;SET ("SCROLL WIDTH":2+INT(Ww/Sc))
1310 CONTROL @Bitmap;SET ("VISIBLE":1)
1320 DIALOG "INFORMATION","File read completed"
1330 END IF
1340 END IF
1350 RETURN
1360 !
1370 ! This routine allows you to cut a section of a bitmap and
1380 ! save it in a file. String variables are used in the FILE
1390 ! dialog to specify the DIALOG BUTTONS attribute and the
1400 ! SELECTION attribute to keep a compact statement length.
1410 !
1420 Savebits: !
1430 S$="Enter file name, then click-and-drag image to save:"
1440 DIALOG "FILE",S$,Btn;SET (A1$:Btns$(*)),RETURN (A2$:Bitfile$)
1450 !
1460 SELECT Btn
1470 CASE 0
1480 S$="BMP" ! Dump format is MS-Windows .BMP file.
1490 CASE 1
1500 S$="XWD" ! Dump format is X11 XWD format.
1510 CASE 2
1520 RETURN
1530 END SELECT
1540 !
1550 CLEAR ERROR
1560 ON ERROR GOSUB Errtrap
1570 CONTROL @Bitmap;SET ("DUMP FORMAT":S$,"DUMP AREA":Bitfile$)
1580 OFF ERROR
1590 IF ERRN<>0 THEN
1600 DIALOG "ERROR","Can't open file."
1610 ELSE
1620 DIALOG "INFORMATION","Bitmap saved to "&S$&" file."
1630 END IF
1640 !
1650 RETURN
1660 !
1670 ! This routine changes directories
1680 !
1690 Chdir: !
1700 S$="Please enter the name of a directory:"
1710 DIALOG "FILE",S$,Btn;RETURN ("DIRECTORY":Dirname$)
1720 !
1730 Err=0
1740 CLEAR ERROR
1750 ON ERROR GOSUB Errtrap
1760 MASS STORAGE IS Dirname$
1770 OFF ERROR
1780 IF ERRN<>0 THEN
1790 DIALOG "ERROR","Can't change directory"
1800 END IF
1810 RETURN
1820 !
1830 ! Dummy routine for trapping errors
1840 !
1850 Errtrap: ERROR RETURN
1860 !
1870 Finis: !
1880 ASSIGN @Main TO * ! Delete PANEL widget
1890 CLEAR SCREEN
