HTBasic Help
×
Menu
Index

Example: HPGL View Viewer

 
10     ! *********************************************************************
20     ! Example: HPGL VIEW Viewer
30     !
40     ! This program demonstrates the use of the HPGL VIEW widget.
50     ! You can use the Menu to import any HPGL file (files with
60     ! a .gl extension).
70     !
80     ! ***************************************************
90     !
100   ! Variables Used:
110   !
120   !   S$:                                General-purpose string
130   !   N:                                General-purpose variable
140   !   Btn:                                Returns button value from dialogs
150   !   Glfile$:                                Name of HPGL file to be read
160   !   Dirname$:                Directory name returned from FILE dialog
170   !
180   DIM S$[256]
190   INTEGER N,Btn,Err
200   DIM Glfile$[100],Dirname$[100]
210   !
220   ! Widget dimensions
230   !
240   INTEGER Pw,Ph,Px,Py,Iw,Ih,Hw,Hh,Hx,Hy
250   !
260   ! Variables for display scaling
270   !
280   INTEGER Dw,Dh,D(1:4)
290   !
300   ! Get display size
310   !
320   GESCAPE CRT,3;D(*)
330   Dw=D(3)-D(1)
340   Dh=D(4)-D(2)
350   !
360   Pw=Dw*.7                                                ! PANEL width
370   Ph=Dh*.7                                                ! PANEL height
380   Px=(Dw-Pw)/2                                ! Center PANEL
390   Py=(Dh-Ph)/2
400   !
410   ! Create PANEL for HPGL widget
420   !
430   ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
440   CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
450   CONTROL @Main;SET ("TITLE":" Example: HPGL Viewer")
460   CONTROL @Main;SET ("SIZE CONTROL":"RESIZE CHILDREN")
470   CONTROL @Main;SET ("MINIMIZABLE":1)
480   !
490   ! Build menu
500   !
510   ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
520   CONTROL @Menu;SET ("LABEL":"Menu")
530   ASSIGN @Getfile TO WIDGET "MENU BUTTON";PARENT @Menu
540   CONTROL @Getfile;SET ("LABEL":"Get HPGL File")
550   ASSIGN @Cd TO WIDGET "MENU BUTTON";PARENT @Menu
560   CONTROL @Cd;SET ("LABEL":"Change Directory")
570   ASSIGN @S TO WIDGET "MENU SEPARATOR";PARENT @Menu
580   ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
590   CONTROL @Quit;SET ("LABEL":"Quit")
600   !
610   ! Create and size HPGL VIEW widget. (Setting RETAIN RASTER
620   ! redraws the widget quickly when overwritten by a dialog.)
630   !
640   ASSIGN @Hpgl TO WIDGET "HPGL VIEW";PARENT @Main
650   CONTROL @Hpgl;SET ("BACKGROUND":0)
660   CONTROL @Hpgl;SET ("RETAIN RASTER":0)
670   STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
680   Hx=Iw*.01
690   Hy=Ih*.01
700   Hh=Ih*.98
710   Hw=Iw*.98
720   CONTROL @Hpgl;SET ("X":Hx,"Y":Hy,"WIDTH":Hw,"HEIGHT":Hh)
730   !
740   ! Set events
750   !
760   ON EVENT @Getfile,"ACTIVATED" GOSUB Gethpgl
770   ON EVENT @Cd,"ACTIVATED" GOSUB Chdir
780   ON EVENT @Quit,"ACTIVATED" GOTO Finis
790   !
800   CONTROL @Main;SET ("VISIBLE":1)
810   !
820   ! Loop and wait for input
830   !
840   LOOP
850     WAIT FOR EVENT
860   END LOOP
870   STOP
880   !
890   ! This routine gets an HPGL file and displays it
900   !
910 Gethpgl:     !
920   S$="Please enter the name of an HPGL file:"
930   DIALOG "FILE",S$,Btn;RETURN ("SELECTION":Glfile$)
940   !
950   IF Btn=0 THEN
960     CLEAR ERROR
970     ON ERROR GOSUB Seterr
980     CONTROL @Hpgl;SET ("HPGL FILE":Glfile$)
990     OFF ERROR
1000    IF ERRN<>0 THEN
1010      DIALOG "ERROR","Cannot open file/invalid HPGL file"
1020    ELSE
1030      DIALOG "INFORMATION","File read completed"
1040    END IF
1050  END IF
1060  RETURN
1070  !
1080  ! This routine changes directories
1090  !
1100 Chdir:    !
1110  S$="Please enter the name of a directory:"
1120  DIALOG "FILE",S$,Btn;RETURN ("DIRECTORY":Dirname$)
1130  CLEAR ERROR
1140  ON ERROR GOSUB Seterr
1150  MASS STORAGE IS Dirname$
1160  OFF ERROR
1170  IF ERRN<>0 THEN
1180    DIALOG "ERROR","Cannot change directory"
1190  END IF
1200  RETURN
1210  !
1220  ! Dummy routine for error traps
1230  !
1240 Seterr: ERROR RETURN
1250  !
1260 Finis:    !
1270  ASSIGN @Main TO *                                ! Deletes PANEL widget
1280  END