home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 109 / EnigmaAmiga109CD.iso / software / sviluppo / powerd / source / examples / adom.d < prev    next >
Encoding:
Text File  |  2000-01-29  |  4.3 KB  |  192 lines
  1. MODULE    'intuition/intuition','utility/tagitem','graphics/text'
  2.  
  3. ENUM    NO,UP,DO,LE,RI,UL,UR,DL,DR,LU,LD
  4.  
  5. PROC Game(w:PTR TO Window,map:PTR TO CHAR,wi,he,le)
  6.     DEF    x=0,y=0,msg:PTR TO IntuiMessage,run=TRUE,tmp="@":UBYTE,go,nx=0,ny=0,
  7.             str:PTR TO CHAR
  8.     tmp:=:map[le*wi*he+y*wi+x]            // put man
  9.     DrawMap(w,map,wi,he,le)
  10.     WHILE run
  11.         WaitPort(w.UserPort)
  12.         IF msg:=GetMsg(w.UserPort)
  13.             SELECT msg.Class
  14.             CASE IDCMP_VANILLAKEY
  15.                 go:=NO
  16.                 SELECT msg.Code
  17.                 CASE "8";    go:=UP
  18.                 CASE "4";    go:=LE
  19.                 CASE "6";    go:=RI
  20.                 CASE "2";    go:=DO
  21.                 CASE "7";    go:=UL
  22.                 CASE "9";    go:=UR
  23.                 CASE "1";    go:=DL
  24.                 CASE "3";    go:=DR
  25.                 CASE "<";    go:=LU
  26.                 CASE ">";    go:=LD
  27.                 CASE "o";    OpenDoor(map,x,y,wi,he,le)
  28.                 CASE "c";    CloseDoor(map,x,y,wi,he,le)
  29.                 ENDSELECT
  30.                 IF go
  31.                     tmp:=:map[le*wi*he+y*wi+x]        // get man
  32.                     SELECT go
  33.                     CASE UP;    ny:=y-1
  34.                     CASE DO;    ny:=y+1
  35.                     CASE LE;    nx:=x-1
  36.                     CASE RI;    nx:=x+1
  37.                     CASE UL;    ny:=y-1;    nx:=x-1
  38.                     CASE UR;    ny:=y-1;    nx:=x+1
  39.                     CASE DL;    ny:=y+1;    nx:=x-1
  40.                     CASE DR;    ny:=y+1;    nx:=x+1
  41.                     CASE LU;    IF map[le*wi*he+y*wi+x]="<" THEN le--
  42.                     CASE LD;    IF map[le*wi*he+y*wi+x]=">" THEN le++
  43.                     ENDSELECT
  44.                     IF nx<0  THEN nx:=0                // bounds
  45.                     IF ny<0  THEN ny:=0
  46.                     IF nx>15 THEN nx:=15
  47.                     IF ny>15 THEN ny:=15
  48.                     SELECT map[le*wi*he+ny*wi+nx]
  49.                     CASE "#","+";    nx:=x;    ny:=y
  50.                     CASE "~";        str:='HEEELP!   '
  51.                     CASE "&";        str:='STATUE    '
  52.                     CASE 34;            str:='BOOK      '
  53.                     CASE "/";        str:='DOOR      '
  54.                     CASE "*";        str:='STONE     '
  55.                     CASE "<";        str:='UPSTAIRS  '
  56.                     CASE ">";        str:='DOWNSTAIRS'
  57.                     DEFAULT;            str:='          '
  58.                     ENDSELECT
  59.                     x:=nx
  60.                     y:=ny
  61.                     tmp:=:map[le*wi*he+y*wi+x]        // put man
  62.                 ENDIF
  63.                 DrawMap(w,map,wi,he,le)
  64.                 PrintIText(w.RPort,[2,0,1,0,0,NIL,str,NIL]:IntuiText,0,0)
  65.             CASE IDCMP_CLOSEWINDOW
  66.                 run:=FALSE
  67.             ENDSELECT
  68.             ReplyMsg(msg)
  69.         ENDIF
  70.     ENDWHILE
  71. ENDPROC
  72.  
  73. PROC OpenDoor(map:PTR TO CHAR,x,y,wi,he,le)
  74.     DEF    door=0,dx,dy,i,j
  75.     map:=map+le*wi*he
  76.     FOR j:=-1 TO 1
  77.         FOR i:=-1 TO 1
  78.             IF map[(y+j)*wi+x+i]="+"
  79.                 door++
  80.                 dx:=x+i
  81.                 dy:=y+j
  82.             ENDIF
  83.         ENDFOR
  84.     ENDFOR
  85.     IF door=1
  86.         map[dy*wi+dx]:="/"
  87.     ENDIF
  88. ENDPROC
  89.  
  90. PROC CloseDoor(map:PTR TO CHAR,x,y,wi,he,le)
  91.     DEF    door=0,dx,dy,i,j
  92.     map:=map+le*wi*he
  93.     FOR j:=-1 TO 1
  94.         FOR i:=-1 TO 1
  95.             IF map[(y+j)*wi+x+i]="/"
  96.                 door++
  97.                 dx:=x+i
  98.                 dy:=y+j
  99.             ENDIF
  100.         ENDFOR
  101.     ENDFOR
  102.     IF door=1
  103.         map[dy*wi+dx]:="+"
  104.     ENDIF
  105. ENDPROC
  106.  
  107. PROC main()
  108.     DEF    map:PTR TO CHAR,w:PTR TO Window
  109.     map:=
  110.         '................'+
  111.         '.........######.'+
  112.         '..#####..#>...#.'+
  113.         '..#...#..#....#.'+
  114.         '..#...#..##/###.'+
  115.         '..###.#.........'+
  116.         '....#.+.........'+
  117.         '....###.........'+
  118.         '................'+
  119.         '................'+
  120.         '................'+
  121.         '..".....~~......'+
  122.         '..#+#..~&~~.....'+
  123.         '..#>#..~~~~.....'+
  124.         '..###.~~~~~.....'+
  125.         '.......~~~~.....'+
  126.  
  127.         '################'+
  128.         '################'+
  129.         '#####....+<...##'+
  130.         '#.#...####....##'+
  131.         '#.#...#####/####'+
  132.         '#+###.###......#'+
  133.         '#..##.#........#'+
  134.         '#.#####........#'+
  135.         '#.+............#'+
  136.         '####...........#'+
  137.         '#..+...........#'+
  138.         '#.###...****...#'+
  139.         '#.#.#.*****....#'+
  140.         '#.#<#..*****...#'+
  141.         '#.+.#.******...#'+
  142.         '################'
  143.  
  144.     IF w:=OpenWindowTags(NIL,
  145.             WA_InnerWidth,20*8,
  146.             WA_InnerHeight,20*8,
  147.             WA_Title,'Dungeon by MarK',
  148.             WA_Flags,WFLG_ACTIVATE|WFLG_RMBTRAP|WFLG_GIMMEZEROZERO|WFLG_CLOSEGADGET|WFLG_DRAGBAR|WFLG_DEPTHGADGET,
  149.             WA_IDCMP,IDCMP_CLOSEWINDOW|IDCMP_VANILLAKEY,
  150.             TAG_END)
  151.         EasyRequestArgs(w,[SIZEOF_EasyStruct,0,'ADOM request',
  152.             'This is only small example in PowerD v0.12\n'+
  153.             'based on Great free game A.D.O.M. (see AmiNet)\n\n'+
  154.             'Control:\n'+
  155.             'use numeric keyboard for moving\n'+
  156.             '"<" go up, only possible on "<" char on the map\n'+
  157.             '">" go down, only possible on ">" char on the map\n'+
  158.             '"o" and "c" to open/close near door\n\n'+
  159.             '       Bye, MarK',
  160.             'OK']:EasyStruct,0,NIL)
  161.         Game(w,map,16,16,0)
  162.         CloseWindow(w)
  163.     ENDIF
  164. ENDPROC
  165.  
  166. PROC DrawMap(w:PTR TO Window,map:PTR TO CHAR,wi,he,le)
  167.     DEF    x,y,c=1,m,s:PTR TO CHAR
  168.     map:=map+le*wi*he
  169.     s:=' '
  170.     FOR y:=0 TO he-1
  171.         FOR x:=0 TO wi-1
  172.             s[0]:=m:=map[y*wi+x]
  173.  
  174.             SELECT m
  175.             CASE "#"
  176.                 c:=2
  177.             CASE ".","&","<",">"
  178.                 c:=4
  179.             CASE "+","/",34,"*"
  180.                 c:=5
  181.             CASE "~"
  182.                 c:=3
  183.             DEFAULT
  184.                 c:=6
  185.             ENDSELECT
  186.  
  187.             PrintIText(w.RPort,[c,1,1,0,0,['topaz.font',8,FS_NORMAL,FPF_ROMFONT]:TextAttr,s,NIL]:IntuiText,x*8+16,y*8+16)
  188.  
  189.         ENDFOR
  190.     ENDFOR
  191. ENDPROC
  192.