home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 8 / amigaformatcd08.iso / screenplay / utilities / hd_installers / pflaunch / pinball.e < prev    next >
Text File  |  1992-09-03  |  7KB  |  184 lines
  1. -> $VER: Pinball Fantasies AGA launcher source (28.4.96)
  2.  
  3. MODULE 'gadtools','libraries/gadtools','graphics/rastport','graphics/text',
  4.        'intuition/intuition','intuition/screens','lowlevel','nonvolatile'
  5.  
  6. DEF hs, win:PTR TO window
  7.  
  8. PROC main()
  9.   -> typed variables
  10.   DEF fnt:PTR TO textfont, g:PTR TO gadget, i:PTR TO gadget,
  11.       m:PTR TO intuimessage, na:PTR TO LONG, rp:PTR TO rastport,
  12.       s:PTR TO screen,
  13.   -> untyped variables
  14.       c, cl, gh, gl, gw, mnu, n, ox, oy, q, v, ww, wh
  15.  
  16.   na:=['Party Land',
  17.        'Speed Devils','Million Dollar Gameshow','Stones ''n'' Bones']:LONG
  18.  
  19.   SetChipRev(-1)
  20.   IF gadtoolsbase:=OpenLibrary('gadtools.library',39)
  21.     IF nvbase:=OpenLibrary('nonvolatile.library',39)
  22.       IF lowlevelbase:=OpenLibrary('lowlevel.library',39)
  23.         IF hs:=AllocMem(266,$10000)
  24.           IF s:=LockPubScreen(NIL)
  25.             /* font sensitive gadget layout calculations */
  26.             rp:=s.rastport; fnt:=rp.font
  27.             ox:=s.wborleft; oy:=rp.txheight+s.wbortop+1; gw:=0
  28.             FOR n:=0 TO 3 DO gw:=Max(gw,TextLength(rp,na[n],StrLen(na[n]))+32)
  29.             gh:=fnt.ysize+6
  30.             ww:=ox+gw+4+s.wborright; wh:=gh+1*4+oy+1+s.wborbottom
  31.             IF v:=GetVisualInfoA(s,[0])
  32.               IF g:=CreateContext({gl})
  33.                 FOR n:=0 TO 3
  34.                   g:=CreateGadgetA(BUTTON_KIND,g,[ox+2,gh+1*n+oy+1,gw,gh,
  35.                      na[n],[Long(fnt+10),fnt.ysize,0,0]:textattr,n,16,v,
  36.                      0]:newgadget,0)
  37.                 ENDFOR
  38.                 IF mnu:=CreateMenusA([1,0,'Project',  0,  0,0,0,
  39.                                       2,0,'About...', '?',0,0,0,
  40.                                       2,0,NM_BARLABEL,0,  0,0,0,
  41.                                       2,0,'Quit',     'Q',0,0,0,
  42.                                       0,0,0,          0,  0,0,0]:newmenu,0)
  43.                   IF LayoutMenusA(mnu,v,[GTMN_NEWLOOKMENUS,1,0])
  44.                     IF win:=OpenWindowTagList(NIL,
  45.                             [WA_LEFT,s.width-ww/2,
  46.                              WA_TOP,s.height-wh/2,
  47.                              WA_WIDTH,ww,
  48.                              WA_HEIGHT,wh,
  49.                              WA_IDCMP,IDCMP_REFRESHWINDOW+
  50.                                       IDCMP_VANILLAKEY+IDCMP_GADGETUP+
  51.                                       IDCMP_CLOSEWINDOW+IDCMP_MENUPICK,
  52.                              WA_FLAGS,$100E,
  53.                              WA_TITLE,'Pinball Fantasies AGA',
  54.                              WA_AUTOADJUST,1,
  55.                              WA_GADGETS,gl,
  56.                              WA_NEWLOOKMENUS,1,NIL])
  57.                       IF SetMenuStrip(win,mnu)
  58.                         Gt_RefreshWindow(win,NIL)
  59.                         REPEAT
  60.                           WaitPort(win.userport)
  61.                           WHILE (m:=Gt_GetIMsg(win.userport))
  62.                             cl:=m.class ; c:=m.code; i:=m.iaddress
  63.                             Gt_ReplyIMsg(m)
  64.                             SELECT cl
  65.                               CASE IDCMP_REFRESHWINDOW
  66.                                 Gt_BeginRefresh(win)
  67.                                 Gt_EndRefresh(win,TRUE)
  68.                               CASE IDCMP_CLOSEWINDOW; q:=1
  69.                               CASE IDCMP_VANILLAKEY
  70.                                 SELECT c
  71.                                   CASE "1"; play(0)
  72.                                   CASE "2"; play(1)
  73.                                   CASE "3"; play(2)
  74.                                   CASE "4"; play(3)
  75.                                   CASE "Q"; q:=1
  76.                                   CASE "q"; q:=1
  77.                                   CASE "\e";q:=1
  78.                                 ENDSELECT
  79.                               CASE IDCMP_GADGETUP; play(i.gadgetid)
  80.                               CASE IDCMP_MENUPICK
  81.                                 SELECT c
  82.                                 -> ugly hack to remove my usual menudecode()
  83.                                   CASE $FFFFF800
  84.                                     EasyRequestArgs(win,[20,0,
  85.                                     'About Pinball Fantasies AGA',{credz},
  86.                                     'OK'],0,0)
  87.                                   CASE $FFFFF840; q:=1
  88.                                 ENDSELECT
  89.                             ENDSELECT
  90.                           ENDWHILE
  91.                         UNTIL q; ClearMenuStrip(win)
  92.                       ENDIF; CloseWindow(win)
  93.                     ENDIF
  94.                   ENDIF; FreeMenus(mnu)
  95.                 ENDIF; FreeGadgets(gl)
  96.               ENDIF; FreeVisualInfo(v)
  97.             ENDIF; UnlockPubScreen(NIL,s)
  98.           ENDIF; FreeMem(hs,266)
  99.         ENDIF; CloseLibrary(lowlevelbase)
  100.       ENDIF; CloseLibrary(nvbase)
  101.     ENDIF; CloseLibrary(gadtoolsbase)
  102.   ENDIF
  103. ENDPROC
  104.  
  105. PROC play(lev)
  106.   DEF lk, ls, nv, od, r:requester,
  107.   d:PTR TO LONG, id:PTR TO LONG, n:PTR TO LONG, o:PTR TO LONG
  108.   n:=['pinfilea.dat','pinfileb.dat','pinfilec.dat','pinfiled.dat']
  109.   d:=['PF2:','PF1:','PF3:','PF4:']; o:=[0,48,128,176]; id:=[0,hs+o[lev],
  110.   hs,dosbase,gfxbase,nvbase,lowlevelbase,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  111.   IF nv:=GetCopyNV('Pinball','Highscore',-1)
  112.     CopyMem(nv,hs,256)
  113.     FreeNVData(nv)
  114.   ELSE
  115.     CopyMem({defsc},hs,256)
  116.   ENDIF
  117.   InitRequester(r); Request(r,win)
  118.   SetWindowPointerA(win,[WA_BUSYPOINTER,1,0])
  119.   IF (ls:=LoadSeg(n[lev]))=0
  120.     IF lk:=Lock(d[lev],-2)
  121.       od:=CurrentDir(lk)
  122.       ls:=LoadSeg(n[lev])
  123.       CurrentDir(od)
  124.       UnLock(lk)
  125.     ENDIF
  126.   ENDIF
  127.   ClearPointer(win); EndRequest(r,win)
  128.   IF ls=0
  129.     EasyRequestArgs(win,[20,0,'Error','Can''t load table','OK'],0,0)
  130.     RETURN
  131.   ENDIF
  132.   Delay(50)
  133.   CacheClearU()
  134.   MOVEM.L D1-D7/A0-A6,-(A7)
  135.   MOVE.L  id,A1
  136.   MOVE.L  ls,A0 -> ls is a BPTR
  137.   ADD.L   A0,A0
  138.   ADD.L   A0,A0
  139.   MOVE.L  A1,A5 -> this is OK, even though E warns you about it!
  140.   SUBA.L  A1,A1
  141.   JSR     4(A0)
  142.   MOVEM.L (A7)+,D1-D7/A0-A6
  143.   TST.L  D0
  144.   BEQ    noscores
  145.   REPEAT
  146.     WaitTOF(); WaitTOF() -> do I really need this wait? i don't have any
  147.                          -> docs on nonvolatile, send me some please!
  148.     IF StoreNV('Pinball','Highscore',hs,26,0)=0 THEN JUMP noscores
  149.   UNTIL (EasyRequestArgs(win,[20,0,'Error','Can''t save highscores',
  150.                                            'Retry|Cancel'],0,0))=0
  151. noscores:
  152.   UnLoadSeg(ls)
  153. ENDPROC
  154.  
  155. defsc:
  156. LONG "TSL ",$00000000,$50000000,
  157.      "TSL ",$00000000,$25000000,
  158.      "TSL ",$00000000,$10000000,
  159.      "TSL ",$00000000,$05000000,
  160.      "TSL ",$00000001,$00000000,
  161.      "TSL ",$00000000,$50000000,
  162.      "TSL ",$00000000,$25000000,
  163.      "TSL ",$00000000,$10000000,
  164.      "   P","ARTY"," LAN","D   ",
  165.      "  SP","EED ","DEVI","LS  ",
  166.      "TSL ",$00000001,$00000000, -> 100,000,000 points
  167.      "TSL ",$00000000,$50000000, ->  50,000,000 points
  168.      "TSL ",$00000000,$25000000, ->  25,000,000 points etc...
  169.      "TSL ",$00000000,$10000000,
  170.      "TSL ",$00000001,$00000000,
  171.      "TSL ",$00000000,$50000000,
  172.      "TSL ",$00000000,$25000000,
  173.      "TSL ",$00000000,$10000000,
  174.      " BIL","LION"," DOL","LAR ",
  175.      " STO","NES ","N BO","NES "
  176.  
  177. credz:
  178. CHAR 'Pinball Fantasies AGA by Digital Illusions.\n\n',
  179.      'Published by 21st Century Entertainment.\0\n\n'
  180. CHAR ' This launcher program is written by Kyzer/CSG \n',
  181.      ' Contact 49 Fairview Road, AB22 8ZG, Scotland. \n\n',
  182.      '$VER: Pinball Fantasies AGA launcher 1.0 (28.4.96)\0'
  183.  
  184.