home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / acc / calendar / calndr / gemshell.lst < prev    next >
Encoding:
File List  |  1992-12-22  |  4.1 KB  |  134 lines
  1. ' GEM Shell
  2. ' by John Eidsvoog
  3. ' Saturday, August 29, 1992
  4. '
  5. @init
  6. ON MENU MESSAGE GOSUB message
  7. ON MENU GOSUB menuselect
  8. ON MENU KEY GOSUB mkey
  9. exit=FALSE
  10. REPEAT
  11.   ON MENU
  12. UNTIL exit
  13. CLOSEW #1
  14. '
  15. PROCEDURE init                     ! Initialize things
  16.   DEFINT "a-z"    ! Make 'em all integers
  17.   DIM menu$(14)
  18.   FOR x=0 TO 14   ! Read in menubar strings
  19.     READ menu$(x)
  20.   NEXT x
  21.   '
  22.   DATA "Desk","  About GEM Shell  ",--------------------,1,2,3,4,5,6,""
  23.   DATA "File","  Quit   ",""
  24.   DATA "",""
  25.   '
  26.   GEMSYS 77              ! graf_handle
  27.   xchar=INT{GINTOUT+2}   ! character width
  28.   ychar=INT{GINTOUT+4}   ! character height
  29.   '
  30.   ~APPL_INIT()
  31.   '
  32.   MENU menu$()
  33.   ~WIND_GET(0,4,wx,wy,ww,wh)        ! Get work area of the desktop
  34.   ~FORM_DIAL(3,0,0,0,0,wx,wy,ww,wh) ! Send a redraw message to the desktop
  35.   wx=ww/2-xchar*17-7     ! Set up a default window size and center it
  36.   wy=wh/2-ychar*6
  37.   ww=xchar*34
  38.   wh=ychar*14
  39.   TITLEW #1," GEM Shell "
  40.   INFOW #1,""
  41.   OPENW #1,wx,wy,ww,wh,&X101111    ! Open our window
  42.   handle=W_HAND(#1)
  43. RETURN
  44. PROCEDURE message                  ! Handle GEM messages
  45.   wx=MENU(5)   ! intout coordinates
  46.   wy=MENU(6)
  47.   ww=MENU(7)
  48.   wh=MENU(8)
  49.   '
  50.   SELECT MENU(1) ! Get message type
  51.   CASE 20        ! WM_REDRAW
  52.     @redraw
  53.   CASE 21        ! WM_TOPPED
  54.     TOPW #1
  55.   CASE 22        ! WM_CLOSED
  56.     @quit
  57.   CASE 23        ! WM_FULLED
  58.     full=1-full  ! Toggle between full and normal
  59.     IF full
  60.       ox=wx      ! If we're going to "full", save old window size
  61.       oy=wy
  62.       ow=ww
  63.       oh=wh
  64.       FULLW #1
  65.     ELSE         ! Otherwise set it back to old size
  66.       ~WIND_SET(handle,5,ox,oy,ow,oh)
  67.     ENDIF
  68.   CASE 27       ! WM_SIZED
  69.     full=0
  70.     ~WIND_SET(handle,5,wx,wy,MAX(180,ww),MAX(80,wh))
  71.   CASE 28       ! WM_MOVED
  72.     full=0
  73.     ~WIND_SET(handle,5,wx,wy,ww,wh)
  74.   ENDSELECT
  75. RETURN
  76. PROCEDURE menuselect               ! Handle menubar selections
  77.   SELECT MENU(5)
  78.   CASE 23
  79.     @about   ! Open the "About" alert box
  80.   CASE 32
  81.     @quit    ! Bail out
  82.   ENDSELECT
  83.   MENU OFF
  84. RETURN
  85. PROCEDURE mkey                     ! Handle keypresses
  86.   k$=UPPER$(CHR$(MENU(14) AND 255))
  87.   SELECT k$
  88.   CASE " "      ! Spacebar brings up About box
  89.     @about
  90.   CASE "Q",27   ! Q or Esc quits program
  91.     @quit
  92.   ENDSELECT
  93. RETURN
  94. PROCEDURE about                    ! Tell 'em what we've got, Bob.
  95.   ALERT 1," | GEM Shell | By John Eidsvoog ",1," OK ",b
  96. RETURN
  97. PROCEDURE redraw                   ! Walk the rectangle list and do redraws
  98.   ~WIND_UPDATE(1)                  ! Lock out other activity while we redraw
  99.   ~WIND_GET(handle,11,rx,ry,rw,rh) ! Get first rectangle in the list
  100.   ~WIND_GET(handle,4,ax,ay,aw,ah)  ! Work area of our window
  101.   REPEAT
  102.     IF RC_INTERSECT(ax,ay,aw,ah,rx,ry,rw,rh)  ! Find intersection
  103.       CLIP rx,ry,rw,rh OFFSET ax,ay           ! Set clipping to the area in question
  104.       CLEARW #1                               ! Clear the area
  105.       @fillwindow                             ! Call our routine to redraw the area
  106.       CLIP 0,0,WORK_OUT(0),WORK_OUT(1)        ! Reset full-screen clipping
  107.     ENDIF
  108.     ~WIND_GET(handle,12,rx,ry,rw,rh) ! Get next rectangle in the list
  109.   UNTIL rw=0 AND rh=0                ! Keep repeating until no more rectangles
  110.   ~WIND_UPDATE(0)                    ! Reenable other GEM activity
  111. RETURN
  112. PROCEDURE fillwindow               ! Redraw sections of our window
  113.   ' Replace this routine with whatever is needed to redraw your window.
  114.   TEXT 8,ychar," This is some sample text,"
  115.   TEXT 8,2*ychar," showing how redraws can"
  116.   TEXT 8,3*ychar," be handled correctly in"
  117.   TEXT 8,4*ychar," GFA while still following"
  118.   TEXT 8,5*ychar," GEM guidelines for multiple"
  119.   TEXT 8,6*ychar," windows.  This window can"
  120.   TEXT 8,7*ychar," be resized, moved, or made"
  121.   TEXT 8,8*ychar," 'full', and windowed ACCs"
  122.   TEXT 8,9*ychar," made be opened and manipu-"
  123.   TEXT 8,10*ychar," lated without redraw"
  124.   TEXT 8,11*ychar," problems."
  125. RETURN
  126. PROCEDURE quit
  127.   ALERT 3," | Do you want to quit? | ",1," Quit | No ",b
  128.   IF b=1
  129.     CLOSEW #1
  130.     ~APPL_EXIT()
  131.     exit=TRUE
  132.   ENDIF
  133. RETURN
  134.