home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 28 / amigaformatcd28.iso / -screenplay- / otherstuff / pflaunch / pinball.e < prev    next >
Text File  |  1998-04-23  |  8KB  |  285 lines
  1. -> $VER: PFLaunch.e 1.2 (11.04.98)
  2.  
  3. /*
  4. Sneaky space-saving constructs
  5.  
  6. I'm using two constants MEMSIZE and NVBLOCK, which are precalculated
  7. calculations with the constant HSLEN (they are HSLEN+10 and HSLEN/10+1,
  8. respectively)
  9.  
  10. Why generate code to manipulate constants?!
  11.  
  12. Uses raw menupick values instead of pulling them out with (code generating)
  13. macros. But why are the values $FFFFxxxx ? Well, because msg.code is an INT,
  14. when I write code:=msg.code, E extracts the INT and sign-extends it to a
  15. LONG. As bit 15 is always set (NOSUBMENU), it's always considered negative.
  16. I could write code:=code AND $FFFF but that's more code for nothing! :)
  17. */
  18.  
  19.  
  20. OPT OSVERSION=39, PREPROCESS
  21.  
  22. MODULE    'dos/dos', 'exec/memory', 'exec/nodes', 'exec/ports',
  23.     'gadtools', 'libraries/gadtools', 'graphics/rastport',
  24.     'graphics/text', 'intuition/intuition', 'intuition/screens',
  25.     'lowlevel', 'nonvolatile', 'utility/tagitem', 'workbench/startup'
  26.  
  27. #define DEF_SCORES [ \
  28. "TSL ",0,$50000000, "TSL ",0,$25000000, "TSL ",0,$10000000, "TSL ",0,$05000000, \
  29. "TSL ",1,$00000000, "TSL ",0,$50000000, "TSL ",0,$25000000, "TSL ",0,$10000000, \
  30. "   P","ARTY"," LAN","D   ", "  SP","EED ","DEVI","LS  ", \
  31. "TSL ",1,$00000000, "TSL ",0,$50000000, "TSL ",0,$25000000, "TSL ",0,$10000000, \
  32. "TSL ",1,$00000000, "TSL ",0,$50000000, "TSL ",0,$25000000, "TSL ",0,$10000000, \
  33. " BIL","LION"," DOL","LAR ", " STO","NES ","N BO","NES "\
  34. ]
  35.  
  36. CONST HSLEN=256, MEMSIZE=266, NVBLOCKS=26
  37.  
  38. OBJECT table
  39.   name, disk:CHAR, hs_off:CHAR
  40. ENDOBJECT
  41.  
  42. DEF w:PTR TO window, s:PTR TO screen, tables:PTR TO table, hs
  43.  
  44. ->---------------------------------------------------------------------------
  45.  
  46. PROC main()
  47.   DEF dir, newdir=NIL
  48.  
  49.   tables := [
  50.     'Party Land',              "2", 0,
  51.     'Speed Devils',            "1", 48,
  52.     'Million Dollar Gameshow', "3", 128,
  53.     'Stones ''n'' Bones',      "4", 176
  54.   ]:table
  55.  
  56.   SetChipRev(-1)
  57.  
  58.   IF newdir := GetProgramDir() THEN
  59.     IF newdir := DupLock(newdir) THEN
  60.       dir := CurrentDir(newdir)
  61.  
  62.   IF gadtoolsbase := OpenLibrary('gadtools.library', 39)
  63.     IF nvbase := OpenLibrary('nonvolatile.library', 39)
  64.       IF lowlevelbase := OpenLibrary('lowlevel.library', 39)
  65.         IF hs := AllocVec(MEMSIZE, MEMF_CLEAR)
  66.           IF s := LockPubScreen(NIL)
  67.  
  68.             createwindow()
  69.  
  70.             UnlockPubScreen(NIL, s)
  71.           ENDIF
  72.           FreeVec(hs)
  73.         ENDIF
  74.         CloseLibrary(lowlevelbase)
  75.       ENDIF
  76.       CloseLibrary(nvbase)
  77.     ENDIF
  78.     CloseLibrary(gadtoolsbase)
  79.   ENDIF
  80.  
  81.   IF newdir THEN UnLock(CurrentDir(dir))
  82. ENDPROC
  83.  
  84. ->---------------------------------------------------------------------------
  85.  
  86. #define TXTLEN(x) TextLength(rp, bla := x, StrLen(bla))
  87.  
  88. PROC createwindow()
  89.   DEF font:PTR TO textfont, gad:PTR TO gadget, rp:PTR TO rastport,
  90.       gadlist, vi, menus, n, bla,
  91.       gad_w=0, gad_h, off_x, off_y, wnd_w, wnd_h
  92.  
  93.   -> font sensitive gadget layout calculations
  94.   rp := s.rastport
  95.   font := rp.font
  96.  
  97.   off_x := s.wborleft
  98.   off_y := s.wbortop + rp.txheight + 1
  99.  
  100.   -> gadget size
  101.   FOR n := 0 TO 3 DO gad_w := Max(gad_w, 32 + TXTLEN(tables[n].name))
  102.   gad_h := 6 + font.ysize
  103.  
  104.   -> window size
  105.   wnd_w := off_x + s.wborright  + gad_w
  106.   wnd_h := off_y + s.wborbottom + (gad_h * 4)
  107.  
  108.   IF vi := GetVisualInfoA(s, NIL)
  109.     IF gad := CreateContext({gadlist})
  110.       FOR n := 0 TO 3 DO gad := CreateGadgetA(BUTTON_KIND, gad, [
  111.         off_x, off_y + (n*gad_h), -> xpos, ypos
  112.         gad_w, gad_h,             -> width, height
  113.         tables[n].name,           -> name
  114.         s.font, n, 16, vi, 0
  115.       ]:newgadget, NIL)
  116.  
  117.       IF menus := CreateMenusA([
  118.         NM_TITLE, 0, 'Project',   NIL, 0,0,0,
  119.         NM_ITEM,  0, 'About...',  '?', 0,0,0,
  120.         NM_ITEM,  0, NM_BARLABEL, NIL, 0,0,0,
  121.         NM_ITEM,  0, 'Quit',      'Q', 0,0,0,
  122.         NM_END,   0, NIL,         NIL, 0,0,0
  123.       ]:newmenu, NIL)
  124.  
  125.         IF LayoutMenusA(menus, vi, [GTMN_NEWLOOKMENUS, TRUE, TAG_DONE])
  126.  
  127.           IF w := OpenWindowTagList(NIL, [
  128.             WA_LEFT,   (s.width - wnd_w) / 2,
  129.             WA_TOP,    (s.height - wnd_h) / 2,
  130.             WA_WIDTH,  wnd_w,
  131.             WA_HEIGHT, wnd_h,
  132.  
  133.             WA_IDCMP, IDCMP_REFRESHWINDOW OR IDCMP_VANILLAKEY OR
  134.                       IDCMP_GADGETUP      OR IDCMP_CLOSEWINDOW OR
  135.                       IDCMP_MENUPICK,
  136.             WA_FLAGS, WFLG_CLOSEGADGET OR WFLG_ACTIVATE OR WFLG_DRAGBAR OR
  137.                       WFLG_DEPTHGADGET OR WFLG_NEWLOOKMENUS,
  138.  
  139.             WA_TITLE, 'Pinball Fantasies AGA',
  140.             WA_SCREENTITLE, 'PFLaunch by Kyzer/CSG <kyzer@4u.net>',
  141.  
  142.             WA_PUBSCREEN, s,
  143.             WA_GADGETS, gadlist,
  144.             TAG_DONE
  145.           ])
  146.  
  147.           IF SetMenuStrip(w, menus)
  148.             Gt_RefreshWindow(w, NIL)
  149.  
  150.             handlewindow()
  151.  
  152.             ClearMenuStrip(w)
  153.             ENDIF
  154.             CloseWindow(w)
  155.           ENDIF
  156.         ENDIF
  157.         FreeMenus(menus)
  158.       ENDIF
  159.       FreeGadgets(gadlist)
  160.     ENDIF
  161.     FreeVisualInfo(vi)
  162.   ENDIF
  163. ENDPROC
  164.  
  165. ->---------------------------------------------------------------------------
  166.  
  167. PROC handlewindow()
  168.   DEF iaddr:PTR TO gadget, msg:PTR TO intuimessage,
  169.       code, class, quitflag=0
  170.  
  171.   REPEAT
  172.     WaitPort(w.userport)
  173.     WHILE msg := Gt_GetIMsg(w.userport)
  174.       class := msg.class
  175.       code  := msg.code
  176.       iaddr := msg.iaddress
  177.       Gt_ReplyIMsg(msg)
  178.  
  179.       SELECT class
  180.       CASE IDCMP_REFRESHWINDOW
  181.         Gt_BeginRefresh(w)
  182.         Gt_EndRefresh(w, TRUE)
  183.  
  184.       CASE IDCMP_CLOSEWINDOW
  185.         quitflag := TRUE
  186.  
  187.       CASE IDCMP_VANILLAKEY
  188.         IF (code >= "1") AND (code <= "4")
  189.           play(code - "1")
  190.         ENDIF
  191.         IF (code = "Q") OR (code = "q") OR (code = "\e")
  192.           quitflag:=TRUE
  193.         ENDIF
  194.  
  195.       CASE IDCMP_GADGETUP
  196.         play(iaddr.gadgetid)  -> gadgetid is 0-3
  197.  
  198.       CASE IDCMP_MENUPICK
  199.         SELECT code
  200.         CASE $FFFFF800   -> 'About...'
  201.           request('by Digital Illusions.\n\n'+
  202.             'Published by 21st Century Entertainment.', 'OK'
  203.           )
  204.         CASE $FFFFF840   -> 'Quit'
  205.           quitflag:=TRUE
  206.         ENDSELECT
  207.       ENDSELECT
  208.     ENDWHILE
  209.   UNTIL quitflag
  210. ENDPROC
  211.  
  212. ->---------------------------------------------------------------------------
  213.  
  214. PROC play(lev)
  215.   DEF req:requester, nv, gamedata:PTR TO LONG,
  216.       dir, loadfile, olddir, file, disk
  217.   
  218.   disk := 'PFx:'
  219.   file := 'pinfilex.dat'
  220.   disk[2] := tables[lev].disk
  221.   file[7] := lev + "a"
  222.  
  223.   IF nv := GetCopyNV('Pinball', 'Highscore', TRUE)
  224.     CopyMem(nv, hs, HSLEN)
  225.     FreeNVData(nv)
  226.   ELSE
  227.     CopyMem(DEF_SCORES, hs, HSLEN)
  228.   ENDIF
  229.  
  230.   InitRequester(req)
  231.   Request(req, w)
  232.   SetWindowPointerA(w, [WA_BUSYPOINTER, TRUE, TAG_DONE])
  233.  
  234.   IF (loadfile := LoadSeg(file))=0
  235.     IF dir := Lock(disk, SHARED_LOCK)
  236.       olddir := CurrentDir(dir)
  237.       loadfile := LoadSeg(file)
  238.       CurrentDir(olddir)
  239.       UnLock(dir)
  240.     ENDIF
  241.   ENDIF
  242.  
  243.   ClearPointer(w)
  244.   EndRequest(req, w)
  245.  
  246.   IF loadfile=0
  247.     request('Can''t load table', 'OK')
  248.     RETURN
  249.   ENDIF
  250.  
  251.   -> this is the data that the game code wants
  252.   gamedata := [
  253.     0, hs+tables[lev].hs_off, hs, dosbase, gfxbase, nvbase, lowlevelbase,
  254.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  255.   ]
  256.  
  257.   Delay(50)
  258.   CacheClearU()
  259.  
  260.     MOVEM.L    D1-D7/A0-A6,-(A7)
  261.     MOVE.L    loadfile,A0
  262.     MOVE.L    gamedata,A5
  263.  
  264.     ADDA.L    A0,A0
  265.     ADDA.L    A0,A0
  266.     JSR    4(A0)
  267.  
  268.     MOVEM.L    (A7)+,D1-D7/A0-A6
  269.     TST.L    D0
  270.     BEQ    noscores
  271.  
  272.   REPEAT
  273.     IF StoreNV('Pinball', 'Highscore', hs, NVBLOCKS, FALSE)=0 THEN
  274.       JUMP out
  275.   UNTIL request('Can''t save highscores', 'Retry|Cancel')=0
  276. out:
  277.  
  278. noscores:
  279.   UnLoadSeg(loadfile)
  280. ENDPROC
  281.  
  282. PROC request(a, b) IS EasyRequestArgs(w, [20, 0, 0, a, b], NIL, NIL)
  283.  
  284. CHAR '$VER: PFLaunch 1.2 (13.04.98)\0'
  285.