home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / wps / editor / epmtools / epmrex / tictac.erx < prev   
Encoding:
Text File  |  1994-01-31  |  13.1 KB  |  404 lines
  1. /* Rexx and roll */
  2. arg char next
  3. if char='CLICK' then do    /* if activated by a mouse */
  4.    'MH_GotoPosition'       /* click, move to that location */
  5.    char = next             /* and set the char to next */
  6. end
  7. if char='' then
  8.    call init               /* set up board */
  9. else if char='X' then
  10.    call X                  /* Do the X thing */
  11. else if char='O' then
  12.    call O                  /* Do the O thing */
  13. else if char='END' then
  14.    call endgame            /* End game if end was pressed */
  15. else
  16.    'sayerror Unrecognised argument.'  /* You fool! */
  17. exit
  18.  
  19. init:
  20.    'xcom e /n'             /* Edit new file */
  21.  
  22.    call etksetfilefield 'autosave',0  /* Turn off autosave */
  23.    call etksetfilefield 'filename','Tic Tac Toe' /*change filename */
  24.  
  25.    /* set .userstring to empty board... */
  26.    parse source . . direct
  27.    'extract /userstring/line/col'
  28.    userstring.1='.........'||line.1 5
  29.    call etksetfilefield 'userstring', userstring.1
  30.  
  31.    /* Define accelerator keys */
  32.    AF_CHAR = 1   /* key style constants */
  33.    AF_VIRTUALKEY  =   2
  34.    VK_END = 19
  35.    'buildaccel ttt' AF_CHAR  88 9002 'rx' direct 'X'
  36.    'buildaccel ttt' AF_CHAR 120 9003 'rx' direct 'X'
  37.    'buildaccel ttt' AF_CHAR  79 9004 'rx' direct 'O'
  38.    'buildaccel ttt' AF_CHAR 111 9005 'rx' direct 'O'
  39.    'buildaccel ttt' AF_VIRTUALKEY VK_END 9006 'rx' direct 'end'
  40.    'activateaccel ttt'
  41.  
  42.    /* Set mouse control */
  43.    'register_mouse 1 1 SECONDCLK 0 rx' direct 'click X'  /* MB1 */
  44.    'register_mouse 1 2 SECONDCLK 0 rx' direct 'click O'  /* MB2 */
  45. /* 'togglecontrol 8 1'
  46.    'setmessageline X=dbl-click MB1; O=dbl-click MB2; End=end game' */
  47.  
  48.    'browse off'
  49.    /* Draw board */
  50.    call etkinserttext '     ║ ║ '
  51.    call etkinserttext '    ═╬═╬═'
  52.    call etkinserttext '     ║ ║ '
  53.    call etkinserttext '    ═╬═╬═'
  54.    call etkinserttext '     ║ ║ '
  55.    call etkinserttext ' '
  56.    call etkinserttext ' '
  57.    call setattributes
  58.    call etksetfilefield 'modify', 0
  59.  
  60.    /* Disable changes to file */
  61.    'browse on'
  62.    call saytext 'And now for something completely different....  The EPM Tic-Tac-Toe Game!' ,
  63.       '                    Press X or double-click MB1 to move X, O or double-click MB2 to move O; End to end game early.'
  64. EXIT
  65.  
  66. setattributes:
  67.    /* Set up fonts */
  68.    'processfontrequest Courier.24.0.0.0.0'
  69.    call etkprocesseditkey  "UNMARK"
  70.    'extract /line'
  71.    getl()+5
  72.    call etkprocesseditkey "MARK_LINE"
  73.    getl()+6
  74.    call etkprocesseditkey "MARK_LINE"
  75.    'processfontrequest Helv.12.0.1.1.1'
  76.    call etkprocesseditkey "UNMARK"
  77.    /* Set color */
  78.    'insert_attr_val_pair 1 159' getl()+5 getl()+6 1 1
  79.    line.1
  80. return
  81.  
  82. saytext:
  83.    text=arg(1)
  84. /*   'sayerror text' text */
  85.    'browse off'
  86.    'extract /windowwidth/line'
  87.    /* Fit text 2 window and display */
  88.    i=0
  89.    do while length(text)>(windowwidth.1*2)
  90.       p=lastpos(' ',text,(windowwidth.1*2))
  91.       if p=0 then
  92.          p=windowwidth.1
  93.       getl()+6+i
  94.       'extract /getline'
  95.       if getline.1='' then
  96.          call etkinserttext center(substr(text,1,p),(windowwidth.1*2))
  97.       else
  98.          call etkreplacetext center(substr(text,1,p),(windowwidth.1*2))
  99.       text=delstr(text,1,p)
  100.       i=i+1
  101.    end /* do */
  102.    getl()+6+i
  103.    'extract /getline'
  104.    if getline.1='' then
  105.       call etkinserttext center(text,(windowwidth.1*2))
  106.    else
  107.       call etkreplacetext center(text,(windowwidth.1*2))
  108.    i=i+1
  109.    getl()+6+i
  110.    /* delete excess lines */
  111.    'extract /getline'
  112.    do while \(getline.1='')
  113.       call etkdeletetext
  114.       getl()+6+i
  115.       'extract /getline'
  116.    end /* do */
  117.    line.1
  118.    'browse on'
  119. return
  120.  
  121. getl:
  122.    /* return line where board is located */
  123.    if symbol('USERSTRING.1')<>'VAR' then
  124.       'extract /userstring'
  125. return substr(userstring.1,10,pos(' ',userstring.1)-10)
  126.  
  127. getc:
  128.    /* return col where board is located */
  129.    if symbol('USERSTRING.1')<>'VAR' then
  130.       'extract /userstring'
  131. return substr(userstring.1,pos(' ',userstring.1)+1)
  132.  
  133. X:
  134.    /* the X proc */
  135.    valid=checkboard(X)  /* Cursor on board ? */
  136.    if valid then
  137.       do
  138.          numbx=countchar()  /* Correct player ? */
  139.          if numbx//2=0 then
  140.            call placechar X
  141.          else
  142.            call saytext "It's O's turn "||insult() /* You Fool! */
  143.       end
  144.    else
  145.       call saytext "The cursor isn't on the board "||insult() /*You Fool!*/
  146.    if qwin() then call winner X   /* Winner ? */
  147. EXIT
  148.  
  149. O:
  150.    /* The O proc */
  151.    valid=checkboard(O)   /* Cursor on board ? */
  152.    if valid then
  153.       do
  154.          numbx=countchar() /* Correct player ? */
  155.          if \(numbx//2=0) then
  156.             call placechar O
  157.          else
  158.             call saytext "It's X's turn "||insult() /* You Fool! */
  159.       end
  160.    else
  161.       call saytext "The cursor isn't on the board "||insult() /* You Fool! */
  162.    if qwin() then call winner O
  163. EXIT
  164.  
  165. countchar:
  166.    numbchar=0    /* Count number of blank spaces */
  167.    do l = 1 to 9
  168.       if \(substr(userstring.1,l,1)='.') then
  169.          numbchar=numbchar+1
  170.    end /* do */
  171. return numbchar
  172.  
  173. checkboard:
  174.    player=arg(1)  /* Cursor on board ? */
  175.    'extract /userstring/line/col/autosave'
  176.    parse var userstring.1 board 10 boardline boardcol
  177.    onboard=0
  178.    ypos=line.1-boardline
  179.    xpos=col.1-boardcol
  180.    if (xpos%2<3)&(xpos%2>-1)&(ypos%2<3)&(ypos%2>-1)&(xpos//2=0)&(ypos//2=0) then
  181.       do
  182.          xpos=xpos%2
  183.          ypos=ypos%2
  184. /*         'sayerror xpos' xpos 'ypos' ypos*/
  185.          onboard=1
  186.       end
  187.    if autosave.1 > 0 then
  188.       call etksetfilefield 'autosave',0 /* Turn off autosave if it is on */
  189. RETURN onboard
  190.  
  191. delmessage:
  192.    /* Delete existing message */
  193.    'extract /line'
  194.    getl()+6
  195.    'extract /getline'
  196.    'browse off'
  197.    do while \(getline.1='')
  198.       call etkdeletetext
  199.       getl()+6
  200.       'extract /getline'
  201.    end /* do */
  202.    'browse on'
  203.    line.1
  204. return
  205.  
  206. placechar:
  207.    player=arg(1)
  208.    /* Put character on board */
  209.    do
  210.       board=substr(userstring.1,1,9)
  211.       if '.'=substr(board,xpos+1+(3*ypos),1) then  /* Position Taken ? */
  212.          do
  213.             'extract /getline'
  214.             'browse off'
  215.             call etkreplacetext overlay(player,getline.1,xpos*2+getc())  /* Replace line in file */
  216.             call etkprocesseditkey "refresh"
  217.             'browse on'
  218.             newusers=overlay(player,userstring.1,xpos+1+(3*ypos))
  219.             call etksetfilefield 'userstring', newusers  /* Replace userstring */
  220.             'sayerror "Take that!" says '||player||'.'  /* Message */
  221.             call delmessage
  222.          end
  223.       else
  224.          call saytext 'Position already taken '||insult() /* You fool! */
  225.    end
  226. return
  227.  
  228. insult:
  229.    /* Put them in their place. */
  230.    nasty='you '  /* the insult starts here. */
  231.    i=0
  232.    do until i=5   /* loop for adjatives */
  233.       wordnumb=random(1,26)  /* pick a number */
  234.       select
  235.          when wordnumb=1 then addin='chair-insulting'  /* profuse vulgarities */
  236.          when wordnumb=2 then addin='liver-eating'
  237.          when wordnumb=3 then addin='olive-green' /*author's favorite!*/
  238.          when wordnumb=4 then addin='slime-covered'
  239.          when wordnumb=5 then addin='mattress-abusing'
  240.          when wordnumb=6 then addin='lyric-singing'
  241.          when wordnumb=7 then addin='wheel-turning'
  242.          when wordnumb=8 then addin='box-closing'
  243.          when wordnumb=9 then addin='bookshelf-reading'
  244.          when wordnumb=10 then addin='camel-pushing'
  245.          when wordnumb=11 then addin='mud-sniffing'
  246.          when wordnumb=12 then addin='cactus-stomping'
  247.          when wordnumb=13 then addin='16-ton-weight-dropping'
  248.          when wordnumb=14 then addin='sidewalk-hopping'
  249.          when wordnumb=15 then addin='basketball-kicking'
  250.          when wordnumb=16 then addin='door-slamming'
  251.          when wordnumb=17 then addin='paperclip-throwing'
  252.          when wordnumb=18 then addin='name-calling'
  253.          when wordnumb=19 then addin='pogo-stick-hating'
  254.          when wordnumb=20 then addin='sewage-filled'
  255.          when wordnumb=21 then addin='squalid'
  256.          when wordnumb=22 then addin='vile'
  257.          when wordnumb=23 then addin='rancid'
  258.          when wordnumb=24 then addin='cheating'
  259.          when wordnumb=25 then addin='silly'
  260.          when wordnumb=26 then addin='dovalicotionating'
  261.       end
  262.       if pos(addin,nasty)=0 then  /* Has the insult been picked already? */
  263.          do
  264.             nasty=nasty||addin||', '  /* Comma, anyone? */
  265.             i=i+1
  266.          end /* do */
  267.    end /* do */
  268.    nasty=substr(nasty,1,length(nasty)-2)
  269.    wordnumb=random(1,19)  /* pick a noun */
  270.    select
  271.       when wordnumb=1 then nasty=nasty 'snarf.'
  272.       when wordnumb=2 then nasty=nasty 'it''s man.'  /* Thank U Python(Monty)! */
  273.       when wordnumb=3 then nasty=nasty 'nick-nack.'
  274.       when wordnumb=4 then nasty=nasty 'person.'
  275.       when wordnumb=5 then nasty=nasty 'ant.'
  276.       when wordnumb=6 then nasty=nasty 'good-for-nothing.'
  277.       when wordnumb=7 then nasty=nasty 'thing.'
  278.       when wordnumb=8 then nasty=nasty 'mound of dirt.' /* author's favorite! */
  279.       when wordnumb=9 then nasty=nasty 'pile of laundry.'
  280.       when wordnumb=10 then nasty=nasty 'landfill.'
  281.       when wordnumb=11 then nasty=nasty 'Elvis impersonator.'
  282.       when wordnumb=12 then nasty=nasty 'UFO spotter.'
  283.       when wordnumb=13 then nasty=nasty 'baby.'
  284.       when wordnumb=14 then nasty=nasty 'tree.'
  285.       when wordnumb=15 then nasty=nasty 'donkey-bottom-biter.'  /* Thank U Python(Monty)! */
  286.       when wordnumb=16 then nasty=nasty 'son of a silly person.' /* Thank U Python(Monty)! */
  287.       when wordnumb=17 then nasty=nasty 'maggot.'
  288.       when wordnumb=18 then nasty=nasty 'grub.'
  289.       when wordnumb=19 then nasty=nasty 'git.'
  290.    end
  291. return nasty
  292.  
  293. qwin:
  294.    /* did u win ? */
  295.    'extract /userstring'
  296.    yo='insert_attr_val_pair 1 192'  /* winning color */
  297.    winvar=0
  298.    i=0
  299.    do until (i=3)|(winvar=1)
  300.       if ('OOO'=substr(userstring.1,1+i*3,3))|('XXX'=substr(userstring.1,1+i*3,3)) then
  301.          do  /* check horizontal */
  302.             templine=(i*2)+substr(userstring.1,10,pos(' ',userstring.1)-10)
  303.             'browse off'
  304.             yo templine templine getc() getc()+4
  305.             'browse on'
  306.             winvar=1
  307.          end /* do */
  308.       if \winvar then
  309.          do   /* check vertical */
  310.             ii=0
  311.             tempstr=''
  312.             do until (ii=3)
  313.                tempstr=tempstr||substr(userstring.1,1+i+ii*3,1)
  314.                ii=ii+1
  315.             end /* do */
  316.             if (tempstr='OOO')|(tempstr='XXX') then
  317.                do
  318.                   ii=0
  319.                   tempcol=(i*2)+substr(userstring.1,pos(' ',userstring.1)+1)
  320.                   'browse off'
  321.                   do until (ii=5)
  322.                      templine=substr(userstring.1,10,pos(' ',userstring.1)-10)+ii
  323.                      yo templine templine tempcol tempcol
  324.                      ii=ii+1
  325.                   end /* do */
  326.                   'browse on'
  327.                   winvar=1
  328.                end /* do */
  329.          end
  330.       i=i+1
  331.    end /* do */
  332.    if \winvar then
  333.       do  /* check diag */
  334.          ii=0
  335.          tempstr=''
  336.          do until (ii=3)
  337.             tempstr=tempstr||substr(userstring.1,1+ii+ii*3,1)
  338.             ii=ii+1
  339.          end /* do */
  340.          if (tempstr='OOO')|(tempstr='XXX') then
  341.             do
  342.                ii=0
  343.                'browse off'
  344.                do until (ii=5)
  345.                   tempcol=substr(userstring.1,pos(' ',userstring.1)+1)+ii
  346.                   templine=substr(userstring.1,10,pos(' ',userstring.1)-10)+ii
  347.                   yo templine templine tempcol tempcol
  348.                   ii=ii+1
  349.                end /* do */
  350.                'browse on'
  351.                winvar=1
  352.             end /* do */
  353.       end
  354.    if \winvar then
  355.       do /* check diag */
  356.          ii=0
  357.          tempstr=''
  358.          do until (ii=3)
  359.             tempstr=tempstr||substr(userstring.1,1+(2-ii)+ii*3,1)
  360.             ii=ii+1
  361.          end /* do */
  362.          if (tempstr='OOO')|(tempstr='XXX') then
  363.             do
  364.                ii=0
  365.                'browse off'
  366.                do until (ii=5)
  367.                   tempcol=substr(userstring.1,pos(' ',userstring.1)+1)+(4-ii)
  368.                   templine=substr(userstring.1,10,pos(' ',userstring.1)-10)+ii
  369.                   yo templine templine tempcol tempcol
  370.                   ii=ii+1
  371.                end /* do */
  372.                'browse on'
  373.                winvar=1
  374.             end /* do */
  375.       end
  376.    if (pos('.',userstring.1)=0)&(\winvar) then
  377.       do  /* tie game */
  378.          call saytext 'DRAW!'
  379.          call endgame
  380.       end /* do */
  381. return winvar
  382.  
  383. winner:
  384.    winchar=arg(1)
  385.    call saytext winchar||' is the winner!'  /* U win! */
  386.    call endgame
  387. exit
  388.  
  389. endgame:
  390.    /* Clean up */
  391.    'browse off'
  392.    'activateaccel defaccel'
  393.    'extract /userstring'
  394.    call etksetfilefield 'modify',0
  395.    parse userstring.1 board 10 boardline boardcol
  396. /*   call etksetfilefield 'line',(boardline+4)
  397.    do 5
  398.       call etkdeletetext
  399.    end /* do */ */
  400.    call etksetfilefield 'line',(boardline)
  401.    'register_mouse 1 1 SECONDCLK 0 MH_double'  /* MB1 */
  402.    'register_mouse 1 2 SECONDCLK 0 markword'   /* MB2 */
  403. exit
  404.